summaryrefslogtreecommitdiff
path: root/gcc/ada/prj-dect.adb
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2003-10-21 13:42:24 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2003-10-21 13:42:24 +0000
commit9dfe12ae5b94d03c997ea2903022a5d2d5c5f266 (patch)
treebdfc70477b60f1220cb05dd233a4570dd9c6bb5c /gcc/ada/prj-dect.adb
parent1c662558a1113238a624245a45382d3df90ccf13 (diff)
downloadgcc-9dfe12ae5b94d03c997ea2903022a5d2d5c5f266.tar.gz
2003-10-21 Arnaud Charlet <charlet@act-europe.fr>
* 3psoccon.ads, 3veacodu.adb, 3vexpect.adb, 3vsoccon.ads, 3vsocthi.adb, 3vsocthi.ads, 3vtrasym.adb, 3zsoccon.ads, 3zsocthi.adb, 3zsocthi.ads, 50system.ads, 51system.ads, 55system.ads, 56osinte.adb, 56osinte.ads, 56taprop.adb, 56taspri.ads, 56tpopsp.adb, 57system.ads, 58system.ads, 59system.ads, 5aml-tgt.adb, 5bml-tgt.adb, 5csystem.ads, 5dsystem.ads, 5fosinte.adb, 5gml-tgt.adb, 5hml-tgt.adb, 5isystem.ads, 5lparame.adb, 5msystem.ads, 5psystem.ads, 5sml-tgt.adb, 5sosprim.adb, 5stpopsp.adb, 5tsystem.ads, 5usystem.ads, 5vml-tgt.adb, 5vsymbol.adb, 5vtraent.adb, 5vtraent.ads, 5wml-tgt.adb, 5xparame.ads, 5xsystem.ads, 5xvxwork.ads, 5yparame.ads, 5ytiitho.adb, 5zinit.adb, 5zml-tgt.adb, 5zparame.ads, 5ztaspri.ads, 5ztfsetr.adb, 5zthrini.adb, 5ztiitho.adb, 5ztpopsp.adb, 7stfsetr.adb, 7straces.adb, 7strafor.adb, 7strafor.ads, 7stratas.adb, a-excach.adb, a-exexda.adb, a-exexpr.adb, a-exextr.adb, a-exstat.adb, a-strsup.adb, a-strsup.ads, a-stwisu.adb, a-stwisu.ads, bld.adb, bld.ads, bld-io.adb, bld-io.ads, clean.adb, clean.ads, ctrl_c.c, erroutc.adb, erroutc.ads, errutil.adb, errutil.ads, err_vars.ads, final.c, g-arrspl.adb, g-arrspl.ads, g-boubuf.adb, g-boubuf.ads, g-boumai.ads, g-bubsor.adb, g-bubsor.ads, g-comver.adb, g-comver.ads, g-ctrl_c.ads, g-dynhta.adb, g-dynhta.ads, g-eacodu.adb, g-excact.adb, g-excact.ads, g-heasor.adb, g-heasor.ads, g-memdum.adb, g-memdum.ads, gnatclean.adb, gnatsym.adb, g-pehage.adb, g-pehage.ads, g-perhas.ads, gpr2make.adb, gpr2make.ads, gprcmd.adb, gprep.adb, gprep.ads, g-semaph.adb, g-semaph.ads, g-string.adb, g-string.ads, g-strspl.ads, g-wistsp.ads, i-vthrea.adb, i-vthrea.ads, i-vxwoio.adb, i-vxwoio.ads, Makefile.generic, Makefile.prolog, Makefile.rtl, prep.adb, prep.ads, prepcomp.adb, prepcomp.ads, prj-err.adb, prj-err.ads, s-boarop.ads, s-carsi8.adb, s-carsi8.ads, s-carun8.adb, s-carun8.ads, s-casi16.adb, s-casi16.ads, s-casi32.adb, s-casi32.ads, s-casi64.adb, s-casi64.ads, s-casuti.adb, s-casuti.ads, s-caun16.adb, s-caun16.ads, s-caun32.adb, s-caun32.ads, s-caun64.adb, s-caun64.ads, scng.adb, scng.ads, s-exnint.adb, s-exnllf.adb, s-exnlli.adb, s-expint.adb, s-explli.adb, s-geveop.adb, s-geveop.ads, s-hibaen.ads, s-htable.adb, s-htable.ads, sinput-c.adb, sinput-c.ads, s-memcop.ads, socket.c, s-purexc.ads, s-scaval.adb, s-stopoo.adb, s-strcom.adb, s-strcom.ads, s-strxdr.adb, s-rident.ads, s-thread.adb, s-thread.ads, s-tpae65.adb, s-tpae65.ads, s-tporft.adb, s-traent.adb, s-traent.ads, styleg.adb, styleg.ads, styleg-c.adb, styleg-c.ads, s-veboop.adb, s-veboop.ads, s-vector.ads, symbols.adb, symbols.ads, tb-alvms.c, tb-alvxw.c, tempdir.adb, tempdir.ads, vms_conv.ads, vms_conv.adb, vms_data.ads, vxaddr2line.adb: Files added. Merge with ACT tree. * 4dintnam.ads, 4mintnam.ads, 4uintnam.ads, 52system.ads, 5dosinte.ads, 5etpopse.adb, 5mosinte.ads, 5qosinte.adb, 5qosinte.ads, 5qstache.adb, 5qtaprop.adb, 5qtaspri.ads, 5stpopse.adb, 5uintman.adb, 5uosinte.ads, adafinal.c, g-enblsp.adb, io-aux.c, scn-nlit.adb, scn-slit.adb, s-exnflt.ads, s-exngen.adb, s-exngen.ads, s-exnlfl.ads, s-exnlin.ads, s-exnsfl.ads, s-exnsin.ads, s-exnssi.ads, s-expflt.ads, s-expgen.adb, s-expgen.ads, s-explfl.ads, s-explin.ads, s-expllf.ads, s-expsfl.ads, s-expsin.ads, s-expssi.ads, style.adb: Files removed. Merge with ACT tree. * 1ic.ads, 31soccon.ads, 31soliop.ads, 3asoccon.ads, 3bsoccon.ads, 3gsoccon.ads, 3hsoccon.ads, 3ssoccon.ads, 3ssoliop.ads, 3wsoccon.ads, 3wsocthi.adb, 3wsocthi.ads, 3wsoliop.ads, 41intnam.ads, 42intnam.ads, 4aintnam.ads, 4cintnam.ads, 4gintnam.ads, 4hexcpol.adb, 4hintnam.ads, 4lintnam.ads, 4nintnam.ads, 4ointnam.ads, 4onumaux.ads, 4pintnam.ads, 4sintnam.ads, 4vcaldel.adb, 4vcalend.adb, 4vintnam.ads, 4wexcpol.adb, 4wintnam.ads, 4zintnam.ads, 51osinte.adb, 51osinte.ads, 52osinte.adb, 52osinte.ads, 53osinte.ads, 54osinte.ads, 5aosinte.adb, 5aosinte.ads, 5asystem.ads, 5ataprop.adb, 5atasinf.ads, 5ataspri.ads, 5atpopsp.adb, 5avxwork.ads, 5bosinte.adb, 5bosinte.ads, 5bsystem.ads, 5cosinte.ads, 5esystem.ads, 5fintman.adb, 5fosinte.ads, 5fsystem.ads, 5ftaprop.adb, 5ftasinf.ads, 5ginterr.adb, 5gintman.adb, 5gmastop.adb, 5gosinte.ads, 5gproinf.ads, 5gsystem.ads, 5gtaprop.adb, 5gtasinf.ads, 5gtpgetc.adb, 5hosinte.adb, 5hosinte.ads, 5hsystem.ads, 5htaprop.adb, 5htaspri.ads, 5htraceb.adb, 5iosinte.adb, 5itaprop.adb, 5itaspri.ads, 5ksystem.ads, 5kvxwork.ads, 5lintman.adb, 5lml-tgt.adb, 5losinte.ads, 5lsystem.ads, 5mvxwork.ads, 5ninmaop.adb, 5nintman.adb, 5nosinte.ads, 5ntaprop.adb, 5ntaspri.ads, 5ointerr.adb, 5omastop.adb, 5oosinte.adb, 5oosinte.ads, 5oosprim.adb, 5oparame.adb, 5osystem.ads, 5otaprop.adb, 5otaspri.ads, 5posinte.ads, 5posprim.adb, 5pvxwork.ads, 5sintman.adb, 5sosinte.adb, 5sosinte.ads, 5ssystem.ads, 5staprop.adb, 5stasinf.ads, 5staspri.ads, 5svxwork.ads, 5tosinte.ads, 5vasthan.adb, 5vinmaop.adb, 5vinterr.adb, 5vintman.adb, 5vintman.ads, 5vmastop.adb, 5vosinte.adb, 5vosinte.ads, 5vosprim.adb, 5vsystem.ads, 5vtaprop.adb, 5vtaspri.ads, 5vtpopde.adb, 5vtpopde.ads, 5wgloloc.adb, 5wintman.adb, 5wmemory.adb, 5wosprim.adb, 5wsystem.ads, 5wtaprop.adb, 5wtaspri.ads, 5ysystem.ads, 5zinterr.adb, 5zintman.adb, 5zosinte.adb, 5zosinte.ads, 5zosprim.adb, 5zsystem.ads, 5ztaprop.adb, 6vcpp.adb, 6vcstrea.adb, 6vinterf.ads, 7sinmaop.adb, 7sintman.adb, 7sosinte.adb, 7sosprim.adb, 7staprop.adb, 7staspri.ads, 7stpopsp.adb, 7straceb.adb, 9drpc.adb, a-caldel.adb, a-caldel.ads, a-charac.ads, a-colien.ads, a-comlin.adb, adaint.c, adaint.h, ada-tree.def, a-diocst.adb, a-diocst.ads, a-direio.adb, a-except.adb, a-except.ads, a-excpol.adb, a-exctra.adb, a-exctra.ads, a-filico.adb, a-interr.adb, a-intsig.adb, a-intsig.ads, ali.adb, ali.ads, ali-util.adb, ali-util.ads, a-ngcefu.adb, a-ngcoty.adb, a-ngelfu.adb, a-nudira.adb, a-nudira.ads, a-nuflra.adb, a-nuflra.ads, a-reatim.adb, a-reatim.ads, a-retide.ads, a-sequio.adb, a-siocst.adb, a-siocst.ads, a-ssicst.adb, a-ssicst.ads, a-strbou.adb, a-strbou.ads, a-strfix.adb, a-strmap.adb, a-strsea.ads, a-strunb.adb, a-strunb.ads, a-ststio.adb, a-stunau.adb, a-stunau.ads, a-stwibo.adb, a-stwibo.ads, a-stwifi.adb, a-stwima.adb, a-stwiun.adb, a-stwiun.ads, a-tags.adb, a-tags.ads, a-tasatt.adb, a-taside.adb, a-teioed.adb, a-textio.adb, a-textio.ads, a-tienau.adb, a-tifiio.adb, a-tiflau.adb, a-tiflio.adb, a-tigeau.adb, a-tigeau.ads, a-tiinau.adb, a-timoau.adb, a-tiocst.adb, a-tiocst.ads, atree.adb, atree.ads, a-witeio.adb, a-witeio.ads, a-wtcstr.adb, a-wtcstr.ads, a-wtdeio.adb, a-wtedit.adb, a-wtenau.adb, a-wtflau.adb, a-wtinau.adb, a-wtmoau.adb, bcheck.adb, binde.adb, bindgen.adb, bindusg.adb, checks.adb, checks.ads, cio.c, comperr.adb, comperr.ads, csets.adb, cstand.adb, cstreams.c, debug_a.adb, debug_a.ads, debug.adb, decl.c, einfo.adb, einfo.ads, errout.adb, errout.ads, eval_fat.adb, eval_fat.ads, exp_aggr.adb, expander.adb, expander.ads, exp_attr.adb, exp_ch11.adb, exp_ch13.adb, exp_ch2.adb, exp_ch3.adb, exp_ch3.ads, exp_ch4.adb, exp_ch5.adb, exp_ch6.adb, exp_ch7.adb, exp_ch7.ads, exp_ch8.adb, exp_ch9.adb, exp_code.adb, exp_dbug.adb, exp_dbug.ads, exp_disp.adb, exp_dist.adb, expect.c, exp_fixd.adb, exp_imgv.adb, exp_intr.adb, exp_pakd.adb, exp_prag.adb, exp_strm.adb, exp_strm.ads, exp_tss.adb, exp_tss.ads, exp_util.adb, exp_util.ads, exp_vfpt.adb, fe.h, fmap.adb, fmap.ads, fname.adb, fname.ads, fname-uf.adb, fname-uf.ads, freeze.adb, freeze.ads, frontend.adb, g-awk.adb, g-awk.ads, g-busora.adb, g-busora.ads, g-busorg.adb, g-busorg.ads, g-casuti.adb, g-casuti.ads, g-catiio.adb, g-catiio.ads, g-cgi.adb, g-cgi.ads, g-cgicoo.adb, g-cgicoo.ads, g-cgideb.adb, g-cgideb.ads, g-comlin.adb, g-comlin.ads, g-crc32.adb, g-crc32.ads, g-debpoo.adb, g-debpoo.ads, g-debuti.adb, g-debuti.ads, g-diopit.adb, g-diopit.ads, g-dirope.adb, g-dirope.ads, g-dyntab.adb, g-dyntab.ads, g-except.ads, g-exctra.adb, g-exctra.ads, g-expect.adb, g-expect.ads, g-hesora.adb, g-hesora.ads, g-hesorg.adb, g-hesorg.ads, g-htable.adb, g-htable.ads, gigi.h, g-io.adb, g-io.ads, g-io_aux.adb, g-io_aux.ads, g-locfil.adb, g-locfil.ads, g-md5.adb, g-md5.ads, gmem.c, gnat1drv.adb, gnatbind.adb, gnatchop.adb, gnatcmd.adb, gnatfind.adb, gnatkr.adb, gnatlbr.adb, gnatlink.adb, gnatls.adb, gnatmake.adb, gnatmem.adb, gnatname.adb, gnatprep.adb, gnatprep.ads, gnatpsta.adb, gnatxref.adb, g-os_lib.adb, g-os_lib.ads, g-regexp.adb, g-regexp.ads, g-regist.adb, g-regist.ads, g-regpat.adb, g-regpat.ads, g-soccon.ads, g-socket.adb, g-socket.ads, g-socthi.adb, g-socthi.ads, g-soliop.ads, g-souinf.ads, g-speche.adb, g-speche.ads, g-spipat.adb, g-spipat.ads, g-spitbo.adb, g-spitbo.ads, g-sptabo.ads, g-sptain.ads, g-sptavs.ads, g-table.adb, g-table.ads, g-tasloc.adb, g-tasloc.ads, g-thread.adb, g-thread.ads, g-traceb.adb, g-traceb.ads, g-trasym.adb, g-trasym.ads, hostparm.ads, i-c.ads, i-cobol.adb, i-cpp.adb, i-cstrea.ads, i-cstrin.adb, i-cstrin.ads, impunit.adb, init.c, inline.adb, interfac.ads, i-pacdec.ads, itypes.adb, itypes.ads, i-vxwork.ads, lang.opt, lang-specs.h, layout.adb, lib.adb, lib.ads, lib-list.adb, lib-load.adb, lib-load.ads, lib-sort.adb, lib-util.adb, lib-writ.adb, lib-writ.ads, lib-xref.adb, lib-xref.ads, link.c, live.adb, make.adb, make.ads, Makefile.adalib, Makefile.in, Make-lang.in, makeusg.adb, mdll.adb, mdll-fil.adb, mdll-fil.ads, mdll-utl.adb, mdll-utl.ads, memroot.adb, memroot.ads, memtrack.adb, misc.c, mkdir.c, mlib.adb, mlib.ads, mlib-fil.adb, mlib-fil.ads, mlib-prj.adb, mlib-prj.ads, mlib-tgt.adb, mlib-tgt.ads, mlib-utl.adb, mlib-utl.ads, namet.adb, namet.ads, namet.h, nlists.ads, nlists.h, nmake.adt, opt.adb, opt.ads, osint.adb, osint.ads, osint-b.adb, osint-c.adb, par.adb, par-ch10.adb, par-ch11.adb, par-ch2.adb, par-ch3.adb, par-ch4.adb, par-ch5.adb, par-ch6.adb, par-ch9.adb, par-endh.adb, par-labl.adb, par-load.adb, par-prag.adb, par-sync.adb, par-tchk.adb, par-util.adb, prj.adb, prj.ads, prj-attr.adb, prj-attr.ads, prj-com.adb, prj-com.ads, prj-dect.adb, prj-dect.ads, prj-env.adb, prj-env.ads, prj-ext.adb, prj-ext.ads, prj-makr.adb, prj-makr.ads, prj-nmsc.adb, prj-nmsc.ads, prj-pars.adb, prj-pars.ads, prj-part.adb, prj-part.ads, prj-pp.adb, prj-pp.ads, prj-proc.adb, prj-proc.ads, prj-strt.adb, prj-strt.ads, prj-tree.adb, prj-tree.ads, prj-util.adb, prj-util.ads, raise.c, raise.h, repinfo.adb, repinfo.h, restrict.adb, restrict.ads, rident.ads, rtsfind.adb, rtsfind.ads, s-addima.ads, s-arit64.adb, s-assert.adb, s-assert.ads, s-atacco.adb, s-atacco.ads, s-auxdec.adb, s-auxdec.ads, s-bitops.adb, scans.ads, scn.adb, scn.ads, s-crc32.adb, s-crc32.ads, s-direio.adb, sem.adb, sem.ads, sem_aggr.adb, sem_attr.adb, sem_attr.ads, sem_case.adb, sem_case.ads, sem_cat.adb, sem_cat.ads, sem_ch10.adb, sem_ch11.adb, sem_ch12.adb, sem_ch12.ads, sem_ch13.adb, sem_ch13.ads, sem_ch3.adb, sem_ch3.ads, sem_ch4.adb, sem_ch5.adb, sem_ch5.ads, sem_ch6.adb, sem_ch6.ads, sem_ch7.adb, sem_ch7.ads, sem_ch8.adb, sem_ch8.ads, sem_ch9.adb, sem_disp.adb, sem_disp.ads, sem_dist.adb, sem_elab.adb, sem_eval.adb, sem_eval.ads, sem_intr.adb, sem_maps.adb, sem_mech.adb, sem_prag.adb, sem_prag.ads, sem_res.adb, sem_res.ads, sem_type.adb, sem_type.ads, sem_util.adb, sem_util.ads, sem_warn.adb, s-errrep.adb, s-errrep.ads, s-exctab.adb, s-exctab.ads, s-exnint.ads, s-exnllf.ads, s-exnlli.ads, s-expint.ads, s-explli.ads, s-expuns.ads, s-fatflt.ads, s-fatgen.adb, s-fatgen.ads, s-fatlfl.ads, s-fatllf.ads, s-fatsfl.ads, s-fileio.adb, s-fileio.ads, s-finimp.adb, s-finimp.ads, s-finroo.adb, s-finroo.ads, sfn_scan.adb, s-gloloc.adb, s-gloloc.ads, s-imgdec.adb, s-imgenu.adb, s-imgrea.adb, s-imgwch.adb, sinfo.adb, sinfo.ads, s-inmaop.ads, sinput.adb, sinput.ads, sinput-d.adb, sinput-l.adb, sinput-l.ads, sinput-p.adb, sinput-p.ads, s-interr.adb, s-interr.ads, s-intman.ads, s-maccod.ads, s-mastop.adb, s-mastop.ads, s-memory.adb, s-memory.ads, snames.adb, snames.ads, snames.h, s-osprim.ads, s-parame.ads, s-parint.ads, s-pooloc.adb, s-pooloc.ads, s-poosiz.adb, sprint.adb, s-proinf.ads, s-scaval.ads, s-secsta.adb, s-secsta.ads, s-sequio.adb, s-shasto.adb, s-shasto.ads, s-soflin.ads, s-stache.adb, s-stache.ads, s-stalib.adb, s-stalib.ads, s-stoele.ads, s-stopoo.ads, s-stratt.adb, s-stratt.ads, s-strops.adb, s-strops.ads, s-taasde.adb, s-taasde.ads, s-tadeca.adb, s-tadeca.ads, s-tadert.adb, s-tadert.ads, s-taenca.adb, s-taenca.ads, s-taprob.adb, s-taprob.ads, s-taprop.ads, s-tarest.adb, s-tarest.ads, s-tasdeb.adb, s-tasdeb.ads, s-tasinf.adb, s-tasinf.ads, s-tasini.adb, s-tasini.ads, s-taskin.adb, s-taskin.ads, s-tasque.adb, s-tasque.ads, s-tasren.adb, s-tasren.ads, s-tasres.ads, s-tassta.adb, s-tassta.ads, s-tasuti.adb, s-tasuti.ads, s-tataat.adb, s-tataat.ads, s-tpinop.adb, s-tpinop.ads, s-tpoben.adb, s-tpoben.ads, s-tpobop.adb, s-tpobop.ads, s-tposen.adb, s-tposen.ads, s-traceb.adb, s-traceb.ads, stringt.adb, stringt.ads, stringt.h, style.ads, stylesw.adb, stylesw.ads, s-unstyp.ads, s-vaflop.ads, s-valrea.adb, s-valuti.adb, s-vercon.adb, s-vmexta.adb, s-wchcnv.ads, s-wchcon.ads, s-widcha.adb, switch.adb, switch.ads, switch-b.adb, switch-c.adb, switch-m.adb, s-wwdcha.adb, s-wwdwch.adb, sysdep.c, system.ads, table.adb, table.ads, targparm.adb, targparm.ads, targtyps.c, tbuild.adb, tbuild.ads, tracebak.c, trans.c, tree_io.adb, treepr.adb, treeprs.adt, ttypes.ads, types.ads, types.h, uintp.adb, uintp.ads, uintp.h, uname.adb, urealp.adb, urealp.ads, urealp.h, usage.adb, utils2.c, utils.c, validsw.adb, validsw.ads, widechar.adb, xeinfo.adb, xnmake.adb, xref_lib.adb, xref_lib.ads, xr_tabls.adb, xr_tabls.ads, xtreeprs.adb, xsnames.adb, einfo.h, sinfo.h, treeprs.ads, nmake.ads, nmake.adb, gnatvsn.ads: Merge with ACT tree. * gnatvsn.adb: Rewritten in a simpler and more efficient way. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@72751 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/prj-dect.adb')
-rw-r--r--gcc/ada/prj-dect.adb532
1 files changed, 407 insertions, 125 deletions
diff --git a/gcc/ada/prj-dect.adb b/gcc/ada/prj-dect.adb
index 37513fe986b..9865dff63c1 100644
--- a/gcc/ada/prj-dect.adb
+++ b/gcc/ada/prj-dect.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2002 Free Software Foundation, Inc --
+-- Copyright (C) 2001-2003 Free Software Foundation, Inc --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -24,19 +24,22 @@
-- --
------------------------------------------------------------------------------
-with Errout; use Errout;
+with Err_Vars; use Err_Vars;
with Namet; use Namet;
+with Prj.Err; use Prj.Err;
with Prj.Strt; use Prj.Strt;
with Prj.Tree; use Prj.Tree;
with Scans; use Scans;
-with Sinfo; use Sinfo;
+with Snames;
with Types; use Types;
with Prj.Attr; use Prj.Attr;
package body Prj.Dect is
type Zone is (In_Project, In_Package, In_Case_Construction);
- -- Needs a comment ???
+ -- Used to indicate if we are parsing a package (In_Package),
+ -- a case construction (In_Case_Construction) or none of those two
+ -- (In_Project).
procedure Parse_Attribute_Declaration
(Attribute : out Project_Node_Id;
@@ -93,7 +96,7 @@ package body Prj.Dect is
begin
Declarations := Default_Project_Node (Of_Kind => N_Project_Declaration);
Set_Location_Of (Declarations, To => Token_Ptr);
- Set_Modified_Project_Of (Declarations, To => Extends);
+ Set_Extended_Project_Of (Declarations, To => Extends);
Set_Project_Declaration_Of (Current_Project, Declarations);
Parse_Declarative_Items
(Declarations => First_Declarative_Item,
@@ -115,7 +118,9 @@ package body Prj.Dect is
Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id)
is
- Current_Attribute : Attribute_Node_Id := First_Attribute;
+ Current_Attribute : Attribute_Node_Id := First_Attribute;
+ Full_Associative_Array : Boolean := False;
+ Attribute_Name : Name_Id := No_Name;
begin
Attribute := Default_Project_Node (Of_Kind => N_Attribute_Declaration);
@@ -125,12 +130,22 @@ package body Prj.Dect is
Scan;
+ -- Body may be an attribute name
+
+ if Token = Tok_Body then
+ Token := Tok_Identifier;
+ Token_Name := Snames.Name_Body;
+ end if;
+
Expect (Tok_Identifier, "identifier");
if Token = Tok_Identifier then
+ Attribute_Name := Token_Name;
Set_Name_Of (Attribute, To => Token_Name);
Set_Location_Of (Attribute, To => Token_Ptr);
+ -- Find the attribute
+
while Current_Attribute /= Empty_Attribute
and then
Attributes.Table (Current_Attribute).Name /= Token_Name
@@ -138,22 +153,81 @@ package body Prj.Dect is
Current_Attribute := Attributes.Table (Current_Attribute).Next;
end loop;
+ -- If not a valid attribute name, issue an error, or a warning
+ -- if inside a package that does not need to be checked.
+
if Current_Attribute = Empty_Attribute then
- Error_Msg ("undefined attribute """ &
- Get_Name_String (Name_Of (Attribute)) &
- """",
- Token_Ptr);
+ declare
+ Message : constant String :=
+ "undefined attribute """ &
+ Get_Name_String (Name_Of (Attribute)) & '"';
+
+ Warning : Boolean :=
+ Current_Package /= Empty_Node
+ and then Current_Packages_To_Check /= All_Packages;
+
+ begin
+ if Warning then
+
+ -- Check that we are not in a package to check
+
+ Get_Name_String (Name_Of (Current_Package));
+
+ for Index in Current_Packages_To_Check'Range loop
+ if Name_Buffer (1 .. Name_Len) =
+ Current_Packages_To_Check (Index).all
+ then
+ Warning := False;
+ exit;
+ end if;
+ end loop;
+ end if;
+
+ if Warning then
+ Error_Msg ('?' & Message, Token_Ptr);
+
+ else
+ Error_Msg (Message, Token_Ptr);
+ end if;
+ end;
+
+ -- Set, if appropriate the index case insensitivity flag
elsif Attributes.Table (Current_Attribute).Kind_2 =
- Case_Insensitive_Associative_Array
+ Case_Insensitive_Associative_Array
then
Set_Case_Insensitive (Attribute, To => True);
end if;
- Scan;
+ Scan; -- past the attribute name
end if;
+ -- Change obsolete names of attributes to the new names
+
+ case Name_Of (Attribute) is
+ when Snames.Name_Specification =>
+ Set_Name_Of (Attribute, To => Snames.Name_Spec);
+
+ when Snames.Name_Specification_Suffix =>
+ Set_Name_Of (Attribute, To => Snames.Name_Spec_Suffix);
+
+ when Snames.Name_Implementation =>
+ Set_Name_Of (Attribute, To => Snames.Name_Body);
+
+ when Snames.Name_Implementation_Suffix =>
+ Set_Name_Of (Attribute, To => Snames.Name_Body_Suffix);
+
+ when others =>
+ null;
+ end case;
+
+ -- Associative array attributes
+
if Token = Tok_Left_Paren then
+
+ -- If the attribute is not an associative array attribute, report
+ -- an error.
+
if Current_Attribute /= Empty_Attribute
and then Attributes.Table (Current_Attribute).Kind_2 = Single
then
@@ -164,69 +238,235 @@ package body Prj.Dect is
Location_Of (Attribute));
end if;
- Scan;
+ Scan; -- past the left parenthesis
Expect (Tok_String_Literal, "literal string");
if Token = Tok_String_Literal then
- Set_Associative_Array_Index_Of (Attribute, Strval (Token_Node));
- Scan;
+ Set_Associative_Array_Index_Of (Attribute, Token_Name);
+ Scan; -- past the literal string index
end if;
- Expect (Tok_Right_Paren, ")");
+ Expect (Tok_Right_Paren, "`)`");
if Token = Tok_Right_Paren then
- Scan;
+ Scan; -- past the right parenthesis
end if;
else
+ -- If it is an associative array attribute and there are no left
+ -- parenthesis, then this is a full associative array declaration.
+ -- Flag it as such for later processing of its value.
+
if Current_Attribute /= Empty_Attribute
and then
Attributes.Table (Current_Attribute).Kind_2 /= Single
then
- Error_Msg ("the attribute """ &
- Get_Name_String
- (Attributes.Table (Current_Attribute).Name) &
- """ needs to be an associative array",
- Location_Of (Attribute));
+ Full_Associative_Array := True;
end if;
end if;
+ -- Set the expression kind of the attribute
+
if Current_Attribute /= Empty_Attribute then
Set_Expression_Kind_Of
(Attribute, To => Attributes.Table (Current_Attribute).Kind_1);
end if;
- Expect (Tok_Use, "use");
+ Expect (Tok_Use, "USE");
if Token = Tok_Use then
Scan;
- declare
- Expression_Location : constant Source_Ptr := Token_Ptr;
- Expression : Project_Node_Id := Empty_Node;
+ if Full_Associative_Array then
- begin
- Parse_Expression
- (Expression => Expression,
- Current_Project => Current_Project,
- Current_Package => Current_Package);
- Set_Expression_Of (Attribute, To => Expression);
-
- if Current_Attribute /= Empty_Attribute
- and then Expression /= Empty_Node
- and then Attributes.Table (Current_Attribute).Kind_1 /=
- Expression_Kind_Of (Expression)
- then
- Error_Msg
- ("wrong expression kind for attribute """ &
- Get_Name_String
- (Attributes.Table (Current_Attribute).Name) &
- """",
- Expression_Location);
- end if;
- end;
+ -- Expect <project>'<same_attribute_name>, or
+ -- <project>.<same_package_name>'<same_attribute_name>
+
+ declare
+ The_Project : Project_Node_Id := Empty_Node;
+ -- The node of the project where the associative array is
+ -- declared.
+
+ The_Package : Project_Node_Id := Empty_Node;
+ -- The node of the package where the associative array is
+ -- declared, if any.
+
+ Project_Name : Name_Id := No_Name;
+ -- The name of the project where the associative array is
+ -- declared.
+
+ Location : Source_Ptr := No_Location;
+ -- The location of the project name
+
+ begin
+ Expect (Tok_Identifier, "identifier");
+
+ if Token = Tok_Identifier then
+ Location := Token_Ptr;
+
+ -- Find the project node in the imported project or
+ -- in the project being extended.
+
+ The_Project := Imported_Or_Extended_Project_Of
+ (Current_Project, Token_Name);
+
+ if The_Project = Empty_Node then
+ Error_Msg ("unknown project", Location);
+ Scan; -- past the project name
+
+ else
+ Project_Name := Token_Name;
+ Scan; -- past the project name
+
+ -- If this is inside a package, a dot followed by the
+ -- name of the package must followed the project name.
+
+ if Current_Package /= Empty_Node then
+ Expect (Tok_Dot, "`.`");
+
+ if Token /= Tok_Dot then
+ The_Project := Empty_Node;
+
+ else
+ Scan; -- past the dot
+ Expect (Tok_Identifier, "identifier");
+
+ if Token /= Tok_Identifier then
+ The_Project := Empty_Node;
+
+ -- If it is not the same package name, issue error
+
+ elsif Token_Name /= Name_Of (Current_Package) then
+ The_Project := Empty_Node;
+ Error_Msg
+ ("not the same package as " &
+ Get_Name_String (Name_Of (Current_Package)),
+ Token_Ptr);
+
+ else
+ The_Package := First_Package_Of (The_Project);
+
+ -- Look for the package node
+
+ while The_Package /= Empty_Node
+ and then Name_Of (The_Package) /= Token_Name
+ loop
+ The_Package :=
+ Next_Package_In_Project (The_Package);
+ end loop;
+
+ -- If the package cannot be found in the
+ -- project, issue an error.
+
+ if The_Package = Empty_Node then
+ The_Project := Empty_Node;
+ Error_Msg_Name_2 := Project_Name;
+ Error_Msg_Name_1 := Token_Name;
+ Error_Msg
+ ("package % not declared in project %",
+ Token_Ptr);
+ end if;
+
+ Scan; -- past the package name
+ end if;
+ end if;
+ end if;
+ end if;
+ end if;
+
+ if The_Project /= Empty_Node then
+
+ -- Looking for '<same attribute name>
+
+ Expect (Tok_Apostrophe, "`''`");
+
+ if Token /= Tok_Apostrophe then
+ The_Project := Empty_Node;
+
+ else
+ Scan; -- past the apostrophe
+ Expect (Tok_Identifier, "identifier");
+
+ if Token /= Tok_Identifier then
+ The_Project := Empty_Node;
+
+ else
+ -- If it is not the same attribute name, issue error
+
+ if Token_Name /= Attribute_Name then
+ The_Project := Empty_Node;
+ Error_Msg_Name_1 := Attribute_Name;
+ Error_Msg ("invalid name, should be %", Token_Ptr);
+ end if;
+
+ Scan; -- past the attribute name
+ end if;
+ end if;
+ end if;
+
+ if The_Project = Empty_Node then
+
+ -- If there were any problem, set the attribute id to null,
+ -- so that the node will not be recorded.
+
+ Current_Attribute := Empty_Attribute;
+
+ else
+ -- Set the appropriate field in the node.
+ -- Note that the index and the expression are nil. This
+ -- characterizes full associative array attribute
+ -- declarations.
+
+ Set_Associative_Project_Of (Attribute, The_Project);
+ Set_Associative_Package_Of (Attribute, The_Package);
+ end if;
+ end;
+
+ -- Other attribute declarations (not full associative array)
+
+ else
+ declare
+ Expression_Location : constant Source_Ptr := Token_Ptr;
+ -- The location of the first token of the expression
+
+ Expression : Project_Node_Id := Empty_Node;
+ -- The expression, value for the attribute declaration
+
+ begin
+ -- Get the expression value and set it in the attribute node
+
+ Parse_Expression
+ (Expression => Expression,
+ Current_Project => Current_Project,
+ Current_Package => Current_Package);
+ Set_Expression_Of (Attribute, To => Expression);
+
+ -- If the expression is legal, but not of the right kind
+ -- for the attribute, issue an error.
+
+ if Current_Attribute /= Empty_Attribute
+ and then Expression /= Empty_Node
+ and then Attributes.Table (Current_Attribute).Kind_1 /=
+ Expression_Kind_Of (Expression)
+ then
+ Error_Msg
+ ("wrong expression kind for attribute """ &
+ Get_Name_String
+ (Attributes.Table (Current_Attribute).Name) &
+ """",
+ Expression_Location);
+ end if;
+ end;
+ end if;
end if;
+ -- If the attribute was not recognized, return an empty node.
+ -- It may be that it is not in a package to check, and the node will
+ -- not be added to the tree.
+
+ if Current_Attribute = Empty_Attribute then
+ Attribute := Empty_Node;
+ end if;
end Parse_Attribute_Declaration;
-----------------------------
@@ -292,7 +532,7 @@ package body Prj.Dect is
end if;
end if;
- Expect (Tok_Is, "is");
+ Expect (Tok_Is, "IS");
if Token = Tok_Is then
@@ -330,7 +570,7 @@ package body Prj.Dect is
Scan;
- Expect (Tok_Arrow, "=>");
+ Expect (Tok_Arrow, "`=>`");
-- Empty_Node in Field1 of a Case_Item indicates
-- the "when others =>" branch.
@@ -355,7 +595,7 @@ package body Prj.Dect is
Parse_Choice_List (First_Choice => First_Choice);
Set_First_Choice_Of (Current_Item, To => First_Choice);
- Expect (Tok_Arrow, "=>");
+ Expect (Tok_Arrow, "`=>`");
Parse_Declarative_Items
(Declarations => First_Declarative_Item,
@@ -372,7 +612,7 @@ package body Prj.Dect is
End_Case_Construction;
- Expect (Tok_End, "end case");
+ Expect (Tok_End, "`END CASE`");
if Token = Tok_End then
@@ -380,7 +620,7 @@ package body Prj.Dect is
Scan;
- Expect (Tok_Case, "case");
+ Expect (Tok_Case, "CASE");
end if;
@@ -388,7 +628,7 @@ package body Prj.Dect is
Scan;
- Expect (Tok_Semicolon, ";");
+ Expect (Tok_Semicolon, "`;`");
end Parse_Case_Construction;
@@ -486,24 +726,29 @@ package body Prj.Dect is
end case;
- Expect (Tok_Semicolon, "; after declarative items");
+ Expect (Tok_Semicolon, "`;` after declarative items");
- if Current_Declarative_Item = Empty_Node then
- Current_Declarative_Item :=
- Default_Project_Node (Of_Kind => N_Declarative_Item);
- Declarations := Current_Declarative_Item;
+ -- Insert an N_Declarative_Item in the tree, but only if
+ -- Current_Declaration is not an empty node.
- else
- Next_Declarative_Item :=
- Default_Project_Node (Of_Kind => N_Declarative_Item);
- Set_Next_Declarative_Item
- (Current_Declarative_Item, To => Next_Declarative_Item);
- Current_Declarative_Item := Next_Declarative_Item;
- end if;
+ if Current_Declaration /= Empty_Node then
+ if Current_Declarative_Item = Empty_Node then
+ Current_Declarative_Item :=
+ Default_Project_Node (Of_Kind => N_Declarative_Item);
+ Declarations := Current_Declarative_Item;
+
+ else
+ Next_Declarative_Item :=
+ Default_Project_Node (Of_Kind => N_Declarative_Item);
+ Set_Next_Declarative_Item
+ (Current_Declarative_Item, To => Next_Declarative_Item);
+ Current_Declarative_Item := Next_Declarative_Item;
+ end if;
- Set_Current_Item_Node
- (Current_Declarative_Item, To => Current_Declaration);
- Set_Location_Of (Current_Declarative_Item, To => Item_Location);
+ Set_Current_Item_Node
+ (Current_Declarative_Item, To => Current_Declaration);
+ Set_Location_Of (Current_Declarative_Item, To => Item_Location);
+ end if;
end loop;
@@ -546,11 +791,16 @@ package body Prj.Dect is
end loop;
if Current_Package = Empty_Package then
- Error_Msg ("""" &
+ Error_Msg ("?""" &
Get_Name_String (Name_Of (Package_Declaration)) &
""" is not an allowed package name",
Token_Ptr);
+ -- Set the package declaration to "ignored" so that it is not
+ -- processed by Prj.Proc.Process.
+
+ Set_Expression_Kind_Of (Package_Declaration, Ignored);
+
else
Set_Package_Id_Of (Package_Declaration, To => Current_Package);
@@ -598,22 +848,37 @@ package body Prj.Dect is
if Token = Tok_Identifier then
declare
- Project_Name : Name_Id := Token_Name;
+ Project_Name : constant Name_Id := Token_Name;
Clause : Project_Node_Id :=
First_With_Clause_Of (Current_Project);
The_Project : Project_Node_Id := Empty_Node;
-
+ Extended : constant Project_Node_Id :=
+ Extended_Project_Of
+ (Project_Declaration_Of (Current_Project));
begin
while Clause /= Empty_Node loop
- The_Project := Project_Node_Of (Clause);
- exit when Name_Of (The_Project) = Project_Name;
+ -- Only non limited imported projects may be used
+ -- in a renames declaration.
+
+ The_Project := Non_Limited_Project_Node_Of (Clause);
+ exit when The_Project /= Empty_Node
+ and then Name_Of (The_Project) = Project_Name;
Clause := Next_With_Clause_Of (Clause);
end loop;
if Clause = Empty_Node then
- Error_Msg ("""" &
- Get_Name_String (Project_Name) &
- """ is not an imported project", Token_Ptr);
+ -- As we have not found the project in the imports, we check
+ -- if it's the name of an eventual extended project.
+
+ if Extended /= Empty_Node
+ and then Name_Of (Extended) = Project_Name then
+ Set_Project_Of_Renamed_Package_Of
+ (Package_Declaration, To => Extended);
+ else
+ Error_Msg_Name_1 := Project_Name;
+ Error_Msg
+ ("% is not an imported or extended project", Token_Ptr);
+ end if;
else
Set_Project_Of_Renamed_Package_Of
(Package_Declaration, To => The_Project);
@@ -621,7 +886,7 @@ package body Prj.Dect is
end;
Scan;
- Expect (Tok_Dot, ".");
+ Expect (Tok_Dot, "`.`");
if Token = Tok_Dot then
Scan;
@@ -662,7 +927,7 @@ package body Prj.Dect is
end if;
end if;
- Expect (Tok_Semicolon, ";");
+ Expect (Tok_Semicolon, "`;`");
elsif Token = Tok_Is then
@@ -676,7 +941,7 @@ package body Prj.Dect is
Set_First_Declarative_Item_Of
(Package_Declaration, To => First_Declarative_Item);
- Expect (Tok_End, "end");
+ Expect (Tok_End, "END");
if Token = Tok_End then
@@ -704,10 +969,10 @@ package body Prj.Dect is
Scan;
end if;
- Expect (Tok_Semicolon, ";");
+ Expect (Tok_Semicolon, "`;`");
else
- Error_Msg ("expected ""is"" or ""renames""", Token_Ptr);
+ Error_Msg ("expected IS or RENAMES", Token_Ptr);
end if;
end Parse_Package_Declaration;
@@ -775,13 +1040,13 @@ package body Prj.Dect is
Scan;
end if;
- Expect (Tok_Is, "is");
+ Expect (Tok_Is, "IS");
if Token = Tok_Is then
Scan;
end if;
- Expect (Tok_Left_Paren, "(");
+ Expect (Tok_Left_Paren, "`(`");
if Token = Tok_Left_Paren then
Scan;
@@ -790,7 +1055,7 @@ package body Prj.Dect is
Parse_String_Type_List (First_String => First_String);
Set_First_Literal_String (String_Type, To => First_String);
- Expect (Tok_Right_Paren, ")");
+ Expect (Tok_Right_Paren, "`)`");
if Token = Tok_Right_Paren then
Scan;
@@ -814,6 +1079,7 @@ package body Prj.Dect is
Project_Location : Source_Ptr := No_Location;
Expression : Project_Node_Id := Empty_Node;
Variable_Name : constant Name_Id := Token_Name;
+ OK : Boolean := True;
begin
Variable :=
@@ -833,7 +1099,9 @@ package body Prj.Dect is
Set_Kind_Of (Variable, N_Typed_Variable_Declaration);
Expect (Tok_Identifier, "identifier");
- if Token = Tok_Identifier then
+ OK := Token = Tok_Identifier;
+
+ if OK then
String_Type_Name := Token_Name;
Type_Location := Token_Ptr;
Scan;
@@ -852,11 +1120,11 @@ package body Prj.Dect is
Type_Location := Token_Ptr;
Scan;
else
- String_Type_Name := No_Name;
+ OK := False;
end if;
end if;
- if String_Type_Name /= No_Name then
+ if OK then
declare
Current : Project_Node_Id :=
First_String_Type_Of (Current_Project);
@@ -900,6 +1168,7 @@ package body Prj.Dect is
Get_Name_String (String_Type_Name) &
"""",
Type_Location);
+ OK := False;
else
Set_String_Type_Of
(Variable, To => Current);
@@ -909,7 +1178,9 @@ package body Prj.Dect is
end if;
end if;
- Expect (Tok_Colon_Equal, ":=");
+ Expect (Tok_Colon_Equal, "`:=`");
+
+ OK := OK and (Token = Tok_Colon_Equal);
if Token = Tok_Colon_Equal then
Scan;
@@ -926,57 +1197,68 @@ package body Prj.Dect is
Set_Expression_Of (Variable, To => Expression);
if Expression /= Empty_Node then
+ -- A typed string must have a single string value, not a list
+
+ if Kind_Of (Variable) = N_Typed_Variable_Declaration
+ and then Expression_Kind_Of (Expression) = List
+ then
+ Error_Msg
+ ("expression must be a single string", Expression_Location);
+ end if;
+
Set_Expression_Kind_Of
(Variable, To => Expression_Kind_Of (Expression));
end if;
- declare
- The_Variable : Project_Node_Id := Empty_Node;
-
- begin
- if Current_Package /= Empty_Node then
- The_Variable := First_Variable_Of (Current_Package);
- elsif Current_Project /= Empty_Node then
- The_Variable := First_Variable_Of (Current_Project);
- end if;
-
- while The_Variable /= Empty_Node
- and then Name_Of (The_Variable) /= Variable_Name
- loop
- The_Variable := Next_Variable (The_Variable);
- end loop;
+ if OK then
+ declare
+ The_Variable : Project_Node_Id := Empty_Node;
- if The_Variable = Empty_Node then
+ begin
if Current_Package /= Empty_Node then
- Set_Next_Variable
- (Variable, To => First_Variable_Of (Current_Package));
- Set_First_Variable_Of (Current_Package, To => Variable);
-
+ The_Variable := First_Variable_Of (Current_Package);
elsif Current_Project /= Empty_Node then
- Set_Next_Variable
- (Variable, To => First_Variable_Of (Current_Project));
- Set_First_Variable_Of (Current_Project, To => Variable);
+ The_Variable := First_Variable_Of (Current_Project);
end if;
- else
- if Expression_Kind_Of (Variable) /= Undefined then
- if Expression_Kind_Of (The_Variable) = Undefined then
- Set_Expression_Kind_Of
- (The_Variable, To => Expression_Kind_Of (Variable));
+ while The_Variable /= Empty_Node
+ and then Name_Of (The_Variable) /= Variable_Name
+ loop
+ The_Variable := Next_Variable (The_Variable);
+ end loop;
- else
- if Expression_Kind_Of (The_Variable) /=
- Expression_Kind_Of (Variable)
- then
- Error_Msg ("wrong expression kind for variable """ &
- Get_Name_String (Name_Of (The_Variable)) &
- """",
- Expression_Location);
+ if The_Variable = Empty_Node then
+ if Current_Package /= Empty_Node then
+ Set_Next_Variable
+ (Variable, To => First_Variable_Of (Current_Package));
+ Set_First_Variable_Of (Current_Package, To => Variable);
+
+ elsif Current_Project /= Empty_Node then
+ Set_Next_Variable
+ (Variable, To => First_Variable_Of (Current_Project));
+ Set_First_Variable_Of (Current_Project, To => Variable);
+ end if;
+
+ else
+ if Expression_Kind_Of (Variable) /= Undefined then
+ if Expression_Kind_Of (The_Variable) = Undefined then
+ Set_Expression_Kind_Of
+ (The_Variable, To => Expression_Kind_Of (Variable));
+
+ else
+ if Expression_Kind_Of (The_Variable) /=
+ Expression_Kind_Of (Variable)
+ then
+ Error_Msg ("wrong expression kind for variable """ &
+ Get_Name_String (Name_Of (The_Variable)) &
+ """",
+ Expression_Location);
+ end if;
end if;
end if;
end if;
- end if;
- end;
+ end;
+ end if;
end Parse_Variable_Declaration;