diff options
| author | Arnaud Charlet <charlet@act-europe.fr> | 2003-10-21 15:42:24 +0200 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2003-10-21 15:42:24 +0200 |
| commit | fbf5a39b3e101719c6bf03cf2cd013b4a312e275 (patch) | |
| tree | bdfc70477b60f1220cb05dd233a4570dd9c6bb5c /gcc/ada/sem_ch5.adb | |
| parent | 75a5a481c2048242ed62c7355381160aa1369616 (diff) | |
| download | gcc-fbf5a39b3e101719c6bf03cf2cd013b4a312e275.tar.gz | |
3psoccon.ads, [...]: Files added.
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.
From-SVN: r72751
Diffstat (limited to 'gcc/ada/sem_ch5.adb')
| -rw-r--r-- | gcc/ada/sem_ch5.adb | 446 |
1 files changed, 354 insertions, 92 deletions
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 10cdec474b2..227bb140446 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2002 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-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- -- @@ -46,6 +46,7 @@ with Sem_Util; use Sem_Util; with Sem_Warn; use Sem_Warn; with Stand; use Stand; with Sinfo; use Sinfo; +with Targparm; use Targparm; with Tbuild; use Tbuild; with Uintp; use Uintp; @@ -66,15 +67,26 @@ package body Sem_Ch5 is procedure Analyze_Iteration_Scheme (N : Node_Id); + procedure Check_Possible_Current_Value_Condition (Cnode : Node_Id); + -- Cnode is N_If_Statement, N_Elsif_Part, or N_Iteration_Scheme + -- (the latter when a WHILE condition is present). This call checks + -- if Condition (Cnode) is of the form ([NOT] var op val), where var + -- is a simple object, val is known at compile time, and op is one + -- of the six relational operators. If this is the case, and the + -- Current_Value field of "var" is not set, then it is set to Cnode. + -- See Exp_Util.Set_Current_Value_Condition for further details. + ------------------------ -- Analyze_Assignment -- ------------------------ procedure Analyze_Assignment (N : Node_Id) is - Lhs : constant Node_Id := Name (N); - Rhs : constant Node_Id := Expression (N); - T1, T2 : Entity_Id; - Decl : Node_Id; + Lhs : constant Node_Id := Name (N); + Rhs : constant Node_Id := Expression (N); + T1 : Entity_Id; + T2 : Entity_Id; + Decl : Node_Id; + Ent : Entity_Id; procedure Diagnose_Non_Variable_Lhs (N : Node_Id); -- N is the node for the left hand side of an assignment, and it @@ -141,7 +153,6 @@ package body Sem_Ch5 is -- If we fall through, we have no special message to issue! Error_Msg_N ("left hand side of assignment must be a variable", N); - end Diagnose_Non_Variable_Lhs; ------------------------- @@ -153,23 +164,36 @@ package body Sem_Ch5 is Opnd_Type : in out Entity_Id) is begin + Require_Entity (Opnd); + -- If the assignment operand is an in-out or out parameter, then we -- get the actual subtype (needed for the unconstrained case). + -- If the operand is the actual in an entry declaration, then within + -- the accept statement it is replaced with a local renaming, which + -- may also have an actual subtype. if Is_Entity_Name (Opnd) and then (Ekind (Entity (Opnd)) = E_Out_Parameter or else Ekind (Entity (Opnd)) = E_In_Out_Parameter or else Ekind (Entity (Opnd)) = - E_Generic_In_Out_Parameter) + E_Generic_In_Out_Parameter + or else + (Ekind (Entity (Opnd)) = E_Variable + and then Nkind (Parent (Entity (Opnd))) = + N_Object_Renaming_Declaration + and then Nkind (Parent (Parent (Entity (Opnd)))) = + N_Accept_Statement)) then Opnd_Type := Get_Actual_Subtype (Opnd); -- If assignment operand is a component reference, then we get the -- actual subtype of the component for the unconstrained case. - elsif Nkind (Opnd) = N_Selected_Component - or else Nkind (Opnd) = N_Explicit_Dereference + elsif + (Nkind (Opnd) = N_Selected_Component + or else Nkind (Opnd) = N_Explicit_Dereference) + and then not Is_Unchecked_Union (Opnd_Type) then Decl := Build_Actual_Subtype_Of_Component (Opnd_Type, Opnd); @@ -213,7 +237,6 @@ package body Sem_Ch5 is while Present (It.Typ) loop if Has_Compatible_Type (Rhs, It.Typ) then - if T1 /= Any_Type then -- An explicit dereference is overloaded if the prefix @@ -232,8 +255,9 @@ package body Sem_Ch5 is Get_First_Interp (Prefix (Lhs), PI, PIt); while Present (PIt.Typ) loop - if Has_Compatible_Type (Rhs, - Designated_Type (PIt.Typ)) + if Is_Access_Type (PIt.Typ) + and then Has_Compatible_Type + (Rhs, Designated_Type (PIt.Typ)) then if Found then PIt := @@ -241,7 +265,10 @@ package body Sem_Ch5 is PI1, PI, Any_Type); if PIt = No_Interp then - return; + Error_Msg_N + ("ambiguous left-hand side" + & " in assignment", Lhs); + exit; else Resolve (Prefix (Lhs), PIt.Typ); end if; @@ -290,6 +317,7 @@ package body Sem_Ch5 is then Error_Msg_N ("left hand of assignment must not be limited type", Lhs); + Explain_Limited_Type (T1, Lhs); return; end if; @@ -302,7 +330,7 @@ package body Sem_Ch5 is Resolve (Rhs, T1); - -- Remaining steps are skipped if Rhs was synatactically in error + -- Remaining steps are skipped if Rhs was syntactically in error if Rhs = Error then return; @@ -310,7 +338,6 @@ package body Sem_Ch5 is T2 := Etype (Rhs); Check_Unset_Reference (Rhs); - Note_Possible_Modification (Lhs); if Covers (T1, T2) then null; @@ -321,6 +348,16 @@ package body Sem_Ch5 is Set_Assignment_Type (Rhs, T2); + if Total_Errors_Detected /= 0 then + if No (T1) then + T1 := Any_Type; + end if; + + if No (T2) then + T2 := Any_Type; + end if; + end if; + if T1 = Any_Type or else T2 = Any_Type then return; end if; @@ -353,10 +390,19 @@ package body Sem_Ch5 is if Is_Scalar_Type (T1) then Apply_Scalar_Range_Check (Rhs, Etype (Lhs)); - elsif Is_Array_Type (T1) then + elsif Is_Array_Type (T1) + and then + (Nkind (Rhs) /= N_Type_Conversion + or else Is_Constrained (Etype (Rhs))) + then -- Assignment verifies that the length of the Lsh and Rhs are equal, - -- but of course the indices do not have to match. + -- but of course the indices do not have to match. If the right-hand + -- side is a type conversion to an unconstrained type, a length check + -- is performed on the expression itself during expansion. In rare + -- cases, the redundant length check is computed on an index type + -- with a different representation, triggering incorrect code in + -- the back end. Apply_Length_Check (Rhs, Etype (Lhs)); @@ -378,8 +424,8 @@ package body Sem_Ch5 is -- Where the entity is the same on both sides and then Is_Entity_Name (Lhs) - and then Is_Entity_Name (Rhs) - and then Entity (Lhs) = Entity (Rhs) + and then Is_Entity_Name (Original_Node (Rhs)) + and then Entity (Lhs) = Entity (Original_Node (Rhs)) -- But exclude the case where the right side was an operation -- that got rewritten (e.g. JUNK + K, where K was known to be @@ -392,6 +438,46 @@ package body Sem_Ch5 is Error_Msg_NE ("?useless assignment of & to itself", N, Entity (Lhs)); end if; + + Note_Possible_Modification (Lhs); + + -- Check for non-allowed composite assignment + + if not Support_Composite_Assign_On_Target + and then (Is_Array_Type (T1) or else Is_Record_Type (T1)) + and then (not Has_Size_Clause (T1) or else Esize (T1) > 64) + then + Error_Msg_CRT ("composite assignment", N); + end if; + + -- One more step. Let's see if we have a simple assignment of a + -- known at compile time value to a simple variable. If so, we + -- can record the value as the current value providing that: + + -- We still have a simple assignment statement (no expansion + -- activity has modified it in some peculiar manner) + + -- The type is a discrete type + + -- The assignment is to a named entity + + -- The value is known at compile time + + if Nkind (N) /= N_Assignment_Statement + or else not Is_Discrete_Type (T1) + or else not Is_Entity_Name (Lhs) + or else not Compile_Time_Known_Value (Rhs) + then + return; + end if; + + Ent := Entity (Lhs); + + -- Capture value if save to do so + + if Safe_To_Capture_Value (N, Ent) then + Set_Current_Value (Ent, Rhs); + end if; end Analyze_Assignment; ----------------------------- @@ -401,7 +487,7 @@ package body Sem_Ch5 is procedure Analyze_Block_Statement (N : Node_Id) is Decls : constant List_Id := Declarations (N); Id : constant Node_Id := Identifier (N); - Ent : Entity_Id; + Ent : Entity_Id := Empty; begin -- If a label is present analyze it and mark it as referenced @@ -409,19 +495,35 @@ package body Sem_Ch5 is if Present (Id) then Analyze (Id); Ent := Entity (Id); - Set_Ekind (Ent, E_Block); - Generate_Reference (Ent, N, ' '); - Generate_Definition (Ent); - if Nkind (Parent (Ent)) = N_Implicit_Label_Declaration then - Set_Label_Construct (Parent (Ent), N); + -- An error defense. If we have an identifier, but no entity, then + -- something is wrong. If we have previous errors, then just remove + -- the identifier and continue, otherwise raise an exception. + + if No (Ent) then + if Total_Errors_Detected /= 0 then + Set_Identifier (N, Empty); + else + raise Program_Error; + end if; + + else + Set_Ekind (Ent, E_Block); + Generate_Reference (Ent, N, ' '); + Generate_Definition (Ent); + + if Nkind (Parent (Ent)) = N_Implicit_Label_Declaration then + Set_Label_Construct (Parent (Ent), N); + end if; end if; + end if; - -- Otherwise create a label entity + -- If no entity set, create a label entity - else + if No (Ent) then Ent := New_Internal_Entity (E_Block, Current_Scope, Sloc (N), 'B'); Set_Identifier (N, New_Occurrence_Of (Ent, Sloc (N))); + Set_Parent (Ent, N); end if; Set_Etype (Ent, Standard_Void_Type); @@ -453,9 +555,7 @@ package body Sem_Ch5 is Set_Has_Nested_Block_With_Handler (S); exit when Is_Overloadable (S) or else Ekind (S) = E_Package - or else Ekind (S) = E_Generic_Function - or else Ekind (S) = E_Generic_Package - or else Ekind (S) = E_Generic_Procedure; + or else Is_Generic_Unit (S); S := Scope (S); end loop; end; @@ -482,7 +582,7 @@ package body Sem_Ch5 is procedure Non_Static_Choice_Error (Choice : Node_Id); -- Error routine invoked by the generic instantiation below when - -- the case statement has a non static choice. + -- the case statment has a non static choice. procedure Process_Statements (Alternative : Node_Id); -- Analyzes all the statements associated to a case alternative. @@ -504,7 +604,8 @@ package body Sem_Ch5 is procedure Non_Static_Choice_Error (Choice : Node_Id) is begin - Error_Msg_N ("choice given in case statement is not static", Choice); + Flag_Non_Static_Expr + ("choice given in case statement is not static!", Choice); end Non_Static_Choice_Error; ------------------------ @@ -599,6 +700,27 @@ package body Sem_Ch5 is else Unblocked_Exit_Count := Save_Unblocked_Exit_Count; end if; + + if not Expander_Active + and then Compile_Time_Known_Value (Expression (N)) + and then Serious_Errors_Detected = 0 + then + declare + Chosen : Node_Id := Find_Static_Alternative (N); + Alt : Node_Id; + + begin + Alt := First (Alternatives (N)); + + while Present (Alt) loop + if Alt /= Chosen then + Remove_Warning_Messages (Statements (Alt)); + end if; + + Next (Alt); + end loop; + end; + end if; end Analyze_Case_Statement; ---------------------------- @@ -708,7 +830,6 @@ package body Sem_Ch5 is end loop; raise Program_Error; - end Analyze_Goto_Statement; -------------------------- @@ -716,13 +837,16 @@ package body Sem_Ch5 is -------------------------- -- A special complication arises in the analysis of if statements. - -- The expander has circuitry to completely deleted code that it + + -- The expander has circuitry to completely delete code that it -- can tell will not be executed (as a result of compile time known -- conditions). In the analyzer, we ensure that code that will be -- deleted in this manner is analyzed but not expanded. This is -- obviously more efficient, but more significantly, difficulties -- arise if code is expanded and then eliminated (e.g. exception - -- table entries disappear). + -- table entries disappear). Similarly, itypes generated in deleted + -- code must be frozen from start, because the nodes on which they + -- depend will not be available at the freeze point. procedure Analyze_If_Statement (N : Node_Id) is E : Node_Id; @@ -730,6 +854,8 @@ package body Sem_Ch5 is Save_Unblocked_Exit_Count : constant Nat := Unblocked_Exit_Count; -- Recursively save value of this global, will be restored on exit + Save_In_Deleted_Code : Boolean; + Del : Boolean := False; -- This flag gets set True if a True condition has been found, -- which means that remaining ELSE/ELSIF parts are deleted. @@ -739,6 +865,10 @@ package body Sem_Ch5 is -- to an N_Elsif_Part node. It deals with analyzing the condition -- and the THEN statements associated with it. + ----------------------- + -- Analyze_Cond_Then -- + ----------------------- + procedure Analyze_Cond_Then (Cnode : Node_Id) is Cond : constant Node_Id := Condition (Cnode); Tstm : constant List_Id := Then_Statements (Cnode); @@ -747,6 +877,7 @@ package body Sem_Ch5 is Unblocked_Exit_Count := Unblocked_Exit_Count + 1; Analyze_And_Resolve (Cond, Any_Boolean); Check_Unset_Reference (Cond); + Check_Possible_Current_Value_Condition (Cnode); -- If already deleting, then just analyze then statements @@ -756,6 +887,7 @@ package body Sem_Ch5 is -- Compile time known value, not deleting yet elsif Compile_Time_Known_Value (Cond) then + Save_In_Deleted_Code := In_Deleted_Code; -- If condition is True, then analyze the THEN statements -- and set no expansion for ELSE and ELSIF parts. @@ -764,13 +896,16 @@ package body Sem_Ch5 is Analyze_Statements (Tstm); Del := True; Expander_Mode_Save_And_Set (False); + In_Deleted_Code := True; -- If condition is False, analyze THEN with expansion off else -- Is_False (Expr_Value (Cond)) Expander_Mode_Save_And_Set (False); + In_Deleted_Code := True; Analyze_Statements (Tstm); Expander_Mode_Restore; + In_Deleted_Code := Save_In_Deleted_Code; end if; -- Not known at compile time, not deleting, normal analysis @@ -817,8 +952,29 @@ package body Sem_Ch5 is if Del then Expander_Mode_Restore; + In_Deleted_Code := Save_In_Deleted_Code; end if; + if not Expander_Active + and then Compile_Time_Known_Value (Condition (N)) + and then Serious_Errors_Detected = 0 + then + if Is_True (Expr_Value (Condition (N))) then + Remove_Warning_Messages (Else_Statements (N)); + + if Present (Elsif_Parts (N)) then + E := First (Elsif_Parts (N)); + + while Present (E) loop + Remove_Warning_Messages (Then_Statements (E)); + Next (E); + end loop; + end if; + + else + Remove_Warning_Messages (Then_Statements (N)); + end if; + end if; end Analyze_If_Statement; ---------------------------------------- @@ -833,10 +989,10 @@ package body Sem_Ch5 is -- Analyze_Label_Entity. procedure Analyze_Implicit_Label_Declaration (N : Node_Id) is - Id : Node_Id := Defining_Identifier (N); + Id : constant Node_Id := Defining_Identifier (N); begin - Enter_Name (Id); + Enter_Name (Id); Set_Ekind (Id, E_Label); Set_Etype (Id, Standard_Void_Type); Set_Enclosing_Scope (Id, Current_Scope); @@ -872,7 +1028,6 @@ package body Sem_Ch5 is LP : constant Node_Id := Loop_Parameter_Specification (N); Id : constant Entity_Id := Defining_Identifier (LP); DS : constant Node_Id := Discrete_Subtype_Definition (LP); - F : List_Id; begin Enter_Name (Id); @@ -932,12 +1087,15 @@ package body Sem_Ch5 is Set_Is_Known_Valid (Id, True); -- The loop is not a declarative part, so the only entity - -- declared "within" must be frozen explicitly. Since the - -- type of this entity has already been frozen, this cannot - -- generate any freezing actions. + -- declared "within" must be frozen explicitly. - F := Freeze_Entity (Id, Sloc (LP)); - pragma Assert (F = No_List); + declare + Flist : constant List_Id := Freeze_Entity (Id, Sloc (N)); + begin + if Is_Non_Empty_List (Flist) then + Insert_Actions (N, Flist); + end if; + end; -- Check for null or possibly null range and issue warning. -- We suppress such messages in generic templates and @@ -946,8 +1104,6 @@ package body Sem_Ch5 is if Nkind (DS) = N_Range and then Comes_From_Source (N) - and then not Inside_A_Generic - and then not In_Instance then declare L : constant Node_Id := Low_Bound (DS); @@ -967,14 +1123,42 @@ package body Sem_Ch5 is -- If range of loop is null, issue warning if (LOK and HOK) and then Llo > Hhi then - Error_Msg_N - ("?loop range is null, loop will not execute", - DS); + + -- Suppress the warning if inside a generic + -- template or instance, since in practice + -- they tend to be dubious in these cases since + -- they can result from intended parametrization. + + if not Inside_A_Generic + and then not In_Instance + then + Error_Msg_N + ("?loop range is null, loop will not execute", + DS); + end if; + + -- Since we know the range of the loop is null, + -- set the appropriate flag to suppress any + -- warnings that would otherwise be issued in + -- the body of the loop that will not execute. + -- We do this even in the generic case, since + -- if it is dubious to warn on the null loop + -- itself, it is certainly dubious to warn for + -- conditions that occur inside it! + + Set_Is_Null_Loop (Parent (N)); -- The other case for a warning is a reverse loop -- where the upper bound is the integer literal -- zero or one, and the lower bound can be positive. + -- For example, we have + + -- for J in reverse N .. 1 loop + + -- In practice, this is very likely to be a case + -- of reversing the bounds incorrectly in the range. + elsif Reverse_Present (LP) and then Nkind (H) = N_Integer_Literal and then (Intval (H) = Uint_0 @@ -982,9 +1166,7 @@ package body Sem_Ch5 is Intval (H) = Uint_1) and then Lhi > Hhi then - Warn_On_Instance := True; Error_Msg_N ("?loop range may be null", DS); - Warn_On_Instance := False; end if; end; end if; @@ -998,41 +1180,18 @@ package body Sem_Ch5 is -- Analyze_Label -- ------------------- - -- Important note: normally this routine is called from Analyze_Statements - -- which does a prescan, to make sure that the Reachable flags are set on - -- all labels before encountering a possible goto to one of these labels. - -- If expanded code analyzes labels via the normal Sem path, then it must - -- ensure that Reachable is set early enough to avoid problems in the case - -- of a forward goto. + -- Note: the semantic work required for analyzing labels (setting them as + -- reachable) was done in a prepass through the statements in the block, + -- so that forward gotos would be properly handled. See Analyze_Statements + -- for further details. The only processing required here is to deal with + -- optimizations that depend on an assumption of sequential control flow, + -- since of course the occurrence of a label breaks this assumption. procedure Analyze_Label (N : Node_Id) is - Lab : Entity_Id; + pragma Warnings (Off, N); begin - Analyze (Identifier (N)); - Lab := Entity (Identifier (N)); - - -- If we found a label mark it as reachable. - - if Ekind (Lab) = E_Label then - Generate_Definition (Lab); - Set_Reachable (Lab); - - if Nkind (Parent (Lab)) = N_Implicit_Label_Declaration then - Set_Label_Construct (Parent (Lab), N); - end if; - - -- If we failed to find a label, it means the implicit declaration - -- of the label was hidden. A for-loop parameter can do this to a - -- label with the same name inside the loop, since the implicit label - -- declaration is in the innermost enclosing body or block statement. - - else - Error_Msg_Sloc := Sloc (Lab); - Error_Msg_N - ("implicit label declaration for & is hidden#", - Identifier (N)); - end if; + Kill_Current_Values; end Analyze_Label; -------------------------- @@ -1088,11 +1247,18 @@ package body Sem_Ch5 is Set_Parent (Ent, N); end if; + -- Kill current values on entry to loop, since statements in body + -- of loop may have been executed before the loop is entered. + -- Similarly we kill values after the loop, since we do not know + -- that the body of the loop was executed. + + Kill_Current_Values; New_Scope (Ent); Analyze_Iteration_Scheme (Iteration_Scheme (N)); Analyze_Statements (Statements (N)); Process_End_Label (N, 'e', Ent); End_Scope; + Kill_Current_Values; end Analyze_Loop_Statement; ---------------------------- @@ -1114,7 +1280,8 @@ package body Sem_Ch5 is ------------------------ procedure Analyze_Statements (L : List_Id) is - S : Node_Id; + S : Node_Id; + Lab : Entity_Id; begin -- The labels declared in the statement list are reachable from @@ -1123,10 +1290,33 @@ package body Sem_Ch5 is -- reachable. This is not required, but is nice behavior! S := First (L); - while Present (S) loop if Nkind (S) = N_Label then - Analyze_Label (S); + Analyze (Identifier (S)); + Lab := Entity (Identifier (S)); + + -- If we found a label mark it as reachable. + + if Ekind (Lab) = E_Label then + Generate_Definition (Lab); + Set_Reachable (Lab); + + if Nkind (Parent (Lab)) = N_Implicit_Label_Declaration then + Set_Label_Construct (Parent (Lab), S); + end if; + + -- If we failed to find a label, it means the implicit declaration + -- of the label was hidden. A for-loop parameter can do this to + -- a label with the same name inside the loop, since the implicit + -- label declaration is in the innermost enclosing body or block + -- statement. + + else + Error_Msg_Sloc := Sloc (Lab); + Error_Msg_N + ("implicit label declaration for & is hidden#", + Identifier (S)); + end if; end if; Next (S); @@ -1134,24 +1324,22 @@ package body Sem_Ch5 is -- Perform semantic analysis on all statements - S := First (L); + Conditional_Statements_Begin; + S := First (L); while Present (S) loop - - if Nkind (S) /= N_Label then - Analyze (S); - end if; - + Analyze (S); Next (S); end loop; + Conditional_Statements_End; + -- Make labels unreachable. Visibility is not sufficient, because -- labels in one if-branch for example are not reachable from the -- other branch, even though their declarations are in the enclosing -- declarative part. S := First (L); - while Present (S) loop if Nkind (S) = N_Label then Set_Reachable (Entity (Identifier (S)), False); @@ -1161,6 +1349,72 @@ package body Sem_Ch5 is end loop; end Analyze_Statements; + -------------------------------------------- + -- Check_Possible_Current_Value_Condition -- + -------------------------------------------- + + procedure Check_Possible_Current_Value_Condition (Cnode : Node_Id) is + Cond : Node_Id; + + begin + -- Loop to deal with (ignore for now) any NOT operators present + + Cond := Condition (Cnode); + while Nkind (Cond) = N_Op_Not loop + Cond := Right_Opnd (Cond); + end loop; + + -- Check possible relational operator + + if Nkind (Cond) = N_Op_Eq + or else + Nkind (Cond) = N_Op_Ne + or else + Nkind (Cond) = N_Op_Ge + or else + Nkind (Cond) = N_Op_Le + or else + Nkind (Cond) = N_Op_Gt + or else + Nkind (Cond) = N_Op_Lt + then + if Compile_Time_Known_Value (Right_Opnd (Cond)) + and then Nkind (Left_Opnd (Cond)) = N_Identifier + then + declare + Ent : constant Entity_Id := Entity (Left_Opnd (Cond)); + + begin + if Ekind (Ent) = E_Variable + or else + Ekind (Ent) = E_Constant + or else + Is_Formal (Ent) + or else + Ekind (Ent) = E_Loop_Parameter + then + -- Here we have a case where the Current_Value field + -- may need to be set. We set it if it is not already + -- set to a compile time expression value. + + -- Note that this represents a decision that one + -- condition blots out another previous one. That's + -- certainly right if they occur at the same level. + -- If the second one is nested, then the decision is + -- neither right nor wrong (it would be equally OK + -- to leave the outer one in place, or take the new + -- inner one. Really we should record both, but our + -- data structures are not that elaborate. + + if Nkind (Current_Value (Ent)) not in N_Subexpr then + Set_Current_Value (Ent, Cnode); + end if; + end if; + end; + end if; + end if; + end Check_Possible_Current_Value_Condition; + ---------------------------- -- Check_Unreachable_Code -- ---------------------------- @@ -1213,7 +1467,15 @@ package body Sem_Ch5 is if Operating_Mode = Generate_Code then loop Nxt := Next (N); - exit when No (Nxt) or else not Is_Statement (Nxt); + + -- Quit deleting when we have nothing more to delete + -- or if we hit a label (since someone could transfer + -- control to a label, so we should not delete it). + + exit when No (Nxt) or else Nkind (Nxt) = N_Label; + + -- Statement/declaration is to be deleted + Analyze (Nxt); Remove (Nxt); Kill_Dead_Code (Nxt); |