diff options
| author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2003-10-21 13:42:24 +0000 |
|---|---|---|
| committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2003-10-21 13:42:24 +0000 |
| commit | 9dfe12ae5b94d03c997ea2903022a5d2d5c5f266 (patch) | |
| tree | bdfc70477b60f1220cb05dd233a4570dd9c6bb5c /gcc/ada/xref_lib.adb | |
| parent | 1c662558a1113238a624245a45382d3df90ccf13 (diff) | |
| download | gcc-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/xref_lib.adb')
| -rw-r--r-- | gcc/ada/xref_lib.adb | 1026 |
1 files changed, 544 insertions, 482 deletions
diff --git a/gcc/ada/xref_lib.adb b/gcc/ada/xref_lib.adb index fcdac58f225..713a91baf83 100644 --- a/gcc/ada/xref_lib.adb +++ b/gcc/ada/xref_lib.adb @@ -2,7 +2,7 @@ -- -- -- GNAT COMPILER COMPONENTS -- -- -- --- X R E F _ L I B -- +-- X R E F _ L I B -- -- -- -- B o d y -- -- -- @@ -19,16 +19,19 @@ -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ with Osint; -with Output; use Output; -with Types; use Types; +with Output; use Output; +with Types; use Types; + with Unchecked_Deallocation; with Ada.Strings.Fixed; use Ada.Strings.Fixed; +with Ada.Text_IO; use Ada.Text_IO; with GNAT.Command_Line; use GNAT.Command_Line; with GNAT.IO_Aux; use GNAT.IO_Aux; @@ -45,31 +48,38 @@ package body Xref_Lib is Pipe : constant Character := '|'; -- First character on xref lines in the .ali file - EOF : constant Character := ASCII.SUB; - -- Special character to signal end of file. Not required in input file, - -- but should be properly treated if present. See also Read_File. - No_Xref_Information : exception; -- Exception raised when there is no cross-referencing information in -- the .ali files - subtype File_Offset is Natural; - - procedure Read_File - (FD : File_Descriptor; - Contents : out String_Access; - Success : out Boolean); - -- Reads file associated with FS into the newly allocated - -- string Contents. An EOF character will be added to the - -- returned Contents to simplify parsing. - -- [VMS] Success is true iff the number of bytes read is less than or - -- equal to the file size. - -- [Other] Success is true iff the number of bytes read is equal to - -- the file size. - - procedure Parse_EOL (Source : access String; Ptr : in out Positive); + procedure Parse_EOL + (Source : access String; + Ptr : in out Positive; + Skip_Continuation_Line : Boolean := False); -- On return Source (Ptr) is the first character of the next line -- or EOF. Source.all must be terminated by EOF. + -- + -- If Skip_Continuation_Line is True, this subprogram skips as many + -- lines as required when the second or more lines starts with '.' + -- (continuation lines in ALI files). + + function Current_Xref_File (File : ALI_File) return File_Reference; + -- Return the file matching the last 'X' line we found while parsing + -- the ALI file. + + function File_Name (File : ALI_File; Num : Positive) return File_Reference; + -- Returns the dependency file name number Num + + function Get_Full_Type (Decl : Declaration_Reference) return String; + -- Returns the full type corresponding to a type letter as found in + -- the .ali files. + + procedure Open + (Name : in String; + File : out ALI_File; + Dependencies : in Boolean := False); + -- Open a new ALI file. If Dependencies is True, the insert every library + -- file 'with'ed in the files database (used for gnatxref) procedure Parse_Identifier_Info (Pattern : Search_Pattern; @@ -77,20 +87,24 @@ package body Xref_Lib is Local_Symbols : Boolean; Der_Info : Boolean := False; Type_Tree : Boolean := False; - Wide_Search : Boolean := True); + Wide_Search : Boolean := True; + Labels_As_Ref : Boolean := True); -- Output the file and the line where the identifier was referenced, -- If Local_Symbols is False then only the publicly visible symbols - -- will be processed + -- will be processed. + -- + -- If Labels_As_Ref is true, then the references to the entities after + -- the end statements ("end Foo") will be counted as actual references. + -- The entity will never be reported as unreferenced by gnatxref -u procedure Parse_Token (Source : access String; Ptr : in out Positive; Token_Ptr : out Positive); -- Skips any separators and stores the start of the token in Token_Ptr. - -- Then stores the position of the next separator in Ptr. - -- On return Source (Token_Ptr .. Ptr - 1) is the token. - -- Separators are space and ASCII.HT. - -- Parse_Token will never skip to the next line. + -- Then stores the position of the next separator in Ptr. On return + -- Source (Token_Ptr .. Ptr - 1) is the token. Separators are space + -- and ASCII.HT. Parse_Token will never skip to the next line. procedure Parse_Number (Source : access String; @@ -103,6 +117,16 @@ package body Xref_Lib is -- Reads and processes "X..." lines in the ALI file -- and updates the File.X_File information. + procedure Skip_To_First_X_Line + (File : in out ALI_File; + D_Lines : Boolean; + W_Lines : Boolean); + -- Skip the lines in the ALI file until the first cross-reference line + -- (^X...) is found. Search is started from the beginning of the file. + -- If not such line is found, No_Xref_Information is raised. + -- If W_Lines is false, then the lines "^W" are not parsed. + -- If D_Lines is false, then the lines "^D" are not parsed. + ---------------- -- Add_Entity -- ---------------- @@ -112,24 +136,23 @@ package body Xref_Lib is Entity : String; Glob : Boolean := False) is - File_Start : Natural; - Line_Start : Natural; - Col_Start : Natural; - Line_Num : Natural := 0; - Col_Num : Natural := 0; - File_Ref : File_Reference := Empty_File; - File_Existed : Boolean; - Has_Pattern : Boolean := False; + File_Start : Natural; + Line_Start : Natural; + Col_Start : Natural; + Line_Num : Natural := 0; + Col_Num : Natural := 0; + File_Ref : File_Reference := Empty_File; + Has_Pattern : Boolean := False; begin -- Find the end of the first item in Entity (pattern or file?) -- If there is no ':', we only have a pattern File_Start := Index (Entity, ":"); - if File_Start = 0 then - -- If the regular expression is invalid, just consider it as a string + -- If the regular expression is invalid, just consider it as a string + if File_Start = 0 then begin Pattern.Entity := Compile (Entity, Glob, False); Pattern.Initialized := True; @@ -162,19 +185,18 @@ package body Xref_Lib is -- If there is a dot in the pattern, then it is a file name if (Glob and then - Index (Entity (Entity'First .. File_Start - 1), ".") /= 0) - or else - (not Glob - and then Index (Entity (Entity'First .. File_Start - 1), + Index (Entity (Entity'First .. File_Start - 1), ".") /= 0) + or else + (not Glob + and then Index (Entity (Entity'First .. File_Start - 1), "\.") /= 0) then - Pattern.Entity := Compile (".*", False); + Pattern.Entity := Compile (".*", False); Pattern.Initialized := True; - File_Start := Entity'First; + File_Start := Entity'First; else - -- If the regular expression is invalid, - -- just consider it as a string + -- If the regular expression is invalid, just consider it as a string begin Pattern.Entity := @@ -251,16 +273,16 @@ package body Xref_Lib is end if; end if; - Add_To_Xref_File (Entity (File_Start .. Line_Start - 1), - File_Existed, - File_Ref, - Visited => True); - Add_Line (File_Ref, Line_Num, Col_Num); - Add_To_Xref_File - (ALI_File_Name (Entity (File_Start .. Line_Start - 1)), - File_Existed, File_Ref, - Visited => False, - Emit_Warning => True); + File_Ref := + Add_To_Xref_File + (Entity (File_Start .. Line_Start - 1), Visited => True); + Pattern.File_Ref := File_Ref; + Add_Line (Pattern.File_Ref, Line_Num, Col_Num); + File_Ref := + Add_To_Xref_File + (ALI_File_Name (Entity (File_Start .. Line_Start - 1)), + Visited => False, + Emit_Warning => True); end Add_Entity; ------------------- @@ -268,9 +290,8 @@ package body Xref_Lib is ------------------- procedure Add_Xref_File (File : String) is - File_Ref : File_Reference := Empty_File; - File_Existed : Boolean; - Iterator : Expansion_Iterator; + File_Ref : File_Reference := Empty_File; + Iterator : Expansion_Iterator; procedure Add_Xref_File_Internal (File : String); -- Do the actual addition of the file @@ -285,26 +306,16 @@ package body Xref_Lib is -- not official usage, since the intention is obvious if Tail (File, 4) = ".ali" then - Add_To_Xref_File - (File, - File_Existed, - File_Ref, - Visited => False, - Emit_Warning => True); + File_Ref := Add_To_Xref_File + (File, Visited => False, Emit_Warning => True); -- Normal non-ali file case else - Add_To_Xref_File - (File, - File_Existed, - File_Ref, - Visited => True); + File_Ref := Add_To_Xref_File (File, Visited => True); - Add_To_Xref_File + File_Ref := Add_To_Xref_File (ALI_File_Name (File), - File_Existed, - File_Ref, Visited => False, Emit_Warning => True); end if; @@ -400,7 +411,6 @@ package body Xref_Lib is My_Dir : Rec_DIR; Dir_Ent : File_Name_String; Last : Natural; - File_Existed : Boolean; File_Ref : File_Reference; function Open_Next_Dir return Boolean; @@ -420,7 +430,7 @@ package body Xref_Lib is Obj_Dir : constant String := Next_Obj_Dir; begin - -- If there was no more Obj_Dir line + -- Case of no more Obj_Dir lines if Obj_Dir'Length = 0 then return False; @@ -430,6 +440,7 @@ package body Xref_Lib is exit; exception + -- Could not open the directory when Directory_Error => null; @@ -442,6 +453,8 @@ package body Xref_Lib is -- Start of processing for Find_ALI_Files begin + Reset_Obj_Dir; + if Open_Next_Dir then loop Read (My_Dir.Dir, Dir_Ent, Last); @@ -454,12 +467,8 @@ package body Xref_Lib is end if; elsif Last > 4 and then Dir_Ent (Last - 3 .. Last) = ".ali" then - Add_To_Xref_File - (Dir_Ent (1 .. Last), - File_Existed, - File_Ref, - Visited => False); - Set_Directory (File_Ref, Current_Obj_Dir); + File_Ref := + Add_To_Xref_File (Dir_Ent (1 .. Last), Visited => False); end if; end loop; end if; @@ -469,9 +478,29 @@ package body Xref_Lib is -- Get_Full_Type -- ------------------- - function Get_Full_Type (Abbrev : Character) return String is + function Get_Full_Type (Decl : Declaration_Reference) return String is + + function Param_String return String; + -- Return the string to display depending on whether Decl is a + -- parameter or not + + ------------------ + -- Param_String -- + ------------------ + + function Param_String return String is + begin + if Is_Parameter (Decl) then + return "parameter "; + else + return ""; + end if; + end Param_String; + + -- Start of processing for Get_Full_Type + begin - case Abbrev is + case Get_Type (Decl) is when 'A' => return "array type"; when 'B' => return "boolean type"; when 'C' => return "class-wide type"; @@ -488,19 +517,21 @@ package body Xref_Lib is when 'W' => return "protected type"; when 'a' => return "array type"; - when 'b' => return "boolean object"; - when 'c' => return "class-wide object"; - when 'd' => return "decimal object"; - when 'e' => return "enumeration object"; - when 'f' => return "float object"; - when 'i' => return "integer object"; - when 'm' => return "modular object"; - when 'o' => return "fixed object"; - when 'p' => return "access object"; - when 'r' => return "record object"; - when 's' => return "string object"; - when 't' => return "task object"; - when 'w' => return "protected object"; + when 'b' => return Param_String & "boolean object"; + when 'c' => return Param_String & "class-wide object"; + when 'd' => return Param_String & "decimal object"; + when 'e' => return Param_String & "enumeration object"; + when 'f' => return Param_String & "float object"; + when 'i' => return Param_String & "integer object"; + when 'm' => return Param_String & "modular object"; + when 'o' => return Param_String & "fixed object"; + when 'p' => return Param_String & "access object"; + when 'r' => return Param_String & "record object"; + when 's' => return Param_String & "string object"; + when 't' => return Param_String & "task object"; + when 'w' => return Param_String & "protected object"; + when 'x' => return Param_String & "abstract procedure"; + when 'y' => return Param_String & "abstract function"; when 'K' => return "package"; when 'k' => return "generic package"; @@ -516,71 +547,38 @@ package body Xref_Lib is when 'X' => return "exception"; when 'Y' => return "entry"; - -- The above should be the only possibilities, but for a - -- tool like this we don't want to bomb if we find something - -- else, so just return ??? when we have an unknown Abbrev value + when '+' => return "private type"; + + -- The above should be the only possibilities, but for this kind + -- of informational output, we don't want to bomb if we find + -- something else, so just return three question marks when we + -- have an unknown Abbrev value when others => - return "???"; + return "??? (" & Get_Type (Decl) & ")"; end case; end Get_Full_Type; - ----------- - -- Match -- - ----------- - - function Match - (Pattern : Search_Pattern; - Symbol : String) - return Boolean - is - begin - -- Get the entity name - - return Match (Symbol, Pattern.Entity); - end Match; - - ---------- - -- Open -- - ---------- + -------------------------- + -- Skip_To_First_X_Line -- + -------------------------- - procedure Open - (Name : String; - File : out ALI_File; - Dependencies : Boolean := False) + procedure Skip_To_First_X_Line + (File : in out ALI_File; + D_Lines : Boolean; + W_Lines : Boolean) is - Name_0 : constant String := Name & ASCII.NUL; - Num_Dependencies : Natural := 0; - File_Existed : Boolean; - File_Ref : File_Reference; - FD : File_Descriptor; - Success : Boolean := False; Ali : String_Access renames File.Buffer; Token : Positive; - Ptr : Positive; + Ptr : Positive := Ali'First; + Num_Dependencies : Natural := 0; + File_Ref : File_Reference; File_Start : Positive; File_End : Positive; Gnatchop_Offset : Integer; Gnatchop_Name : Positive; begin - if File.Buffer /= null then - Free (File.Buffer); - end if; - - Init (File.Dep); - - FD := Open_Read (Name_0'Address, Binary); - - if FD = Invalid_FD then - raise No_Xref_Information; - end if; - - Read_File (FD, Ali, Success); - Close (FD); - - Ptr := Ali'First; - -- Read all the lines possibly processing with-clauses and dependency -- information and exit on finding the first Xref line. -- A fall-through of the loop means that there is no xref information @@ -588,12 +586,12 @@ package body Xref_Lib is while Ali (Ptr) /= EOF loop - if Ali (Ptr) = 'D' then + if D_Lines and then Ali (Ptr) = 'D' then + -- Found dependency information. Format looks like: - -- D source-name time-stamp checksum [subunit-name] \ - -- [line:file-name] + -- D src-nam time-stmp checksum [subunit-name] [line:file-name] - -- Skip the D and parse the filename + -- Skip the D and parse the filenam Ptr := Ptr + 1; Parse_Token (Ali, Ptr, Token); @@ -612,6 +610,7 @@ package body Xref_Lib is end if; -- Did we have a gnatchop-ed file with a pragma Source_Reference ? + Gnatchop_Offset := 0; if Ali (Token) in '0' .. '9' then @@ -619,19 +618,19 @@ package body Xref_Lib is while Ali (Gnatchop_Name) /= ':' loop Gnatchop_Name := Gnatchop_Name + 1; end loop; + Gnatchop_Offset := 2 - Natural'Value (Ali (Token .. Gnatchop_Name - 1)); Token := Gnatchop_Name + 1; end if; - Add_To_Xref_File + File.Dep.Table (Num_Dependencies) := Add_To_Xref_File (Ali (File_Start .. File_End), - File_Existed, - File.Dep.Table (Num_Dependencies), Gnatchop_File => Ali (Token .. Ptr - 1), Gnatchop_Offset => Gnatchop_Offset); - elsif Dependencies and then Ali (Ptr) = 'W' then + elsif W_Lines and then Ali (Ptr) = 'W' then + -- Found with-clause information. Format looks like: -- "W debug%s debug.adb debug.ali" @@ -641,13 +640,11 @@ package body Xref_Lib is Parse_Token (Ali, Ptr, Token); Parse_Token (Ali, Ptr, Token); - Add_To_Xref_File - (Ali (Token .. Ptr - 1), - File_Existed, - File_Ref, - Visited => False); + File_Ref := Add_To_Xref_File + (Ali (Token .. Ptr - 1), Visited => False); elsif Ali (Ptr) = 'X' then + -- Found a cross-referencing line - stop processing File.Current_Line := Ptr; @@ -659,33 +656,70 @@ package body Xref_Lib is end loop; raise No_Xref_Information; + end Skip_To_First_X_Line; + + ---------- + -- Open -- + ---------- + + procedure Open + (Name : String; + File : out ALI_File; + Dependencies : Boolean := False) + is + Ali : String_Access renames File.Buffer; + + begin + if File.Buffer /= null then + Free (File.Buffer); + end if; + + Init (File.Dep); + + begin + Read_File (Name, Ali); + + exception + when Ada.Text_IO.Name_Error | Ada.Text_IO.End_Error => + raise No_Xref_Information; + end; + + Skip_To_First_X_Line (File, D_Lines => True, W_Lines => Dependencies); end Open; --------------- -- Parse_EOL -- --------------- - procedure Parse_EOL (Source : access String; Ptr : in out Positive) is + procedure Parse_EOL + (Source : access String; + Ptr : in out Positive; + Skip_Continuation_Line : Boolean := False) + is begin - -- Skip to end of line - - while Source (Ptr) /= ASCII.CR and then Source (Ptr) /= ASCII.LF - and then Source (Ptr) /= EOF loop - Ptr := Ptr + 1; - end loop; + -- Skip to end of line - if Source (Ptr) /= EOF then - Ptr := Ptr + 1; -- skip CR or LF - end if; + while Source (Ptr) /= ASCII.CR and then Source (Ptr) /= ASCII.LF + and then Source (Ptr) /= EOF + loop + Ptr := Ptr + 1; + end loop; + + if Source (Ptr) /= EOF then + Ptr := Ptr + 1; -- skip CR or LF + end if; - -- Skip past CR/LF or LF/CR combination + -- Skip past CR/LF or LF/CR combination - if (Source (Ptr) = ASCII.CR or else Source (Ptr) = ASCII.LF) - and then Source (Ptr) /= Source (Ptr - 1) - then - Ptr := Ptr + 1; - end if; + if (Source (Ptr) = ASCII.CR or else Source (Ptr) = ASCII.LF) + and then Source (Ptr) /= Source (Ptr - 1) + then + Ptr := Ptr + 1; + end if; + + exit when not Skip_Continuation_Line or else Source (Ptr) /= '.'; + end loop; end Parse_EOL; --------------------------- @@ -698,7 +732,8 @@ package body Xref_Lib is Local_Symbols : Boolean; Der_Info : Boolean := False; Type_Tree : Boolean := False; - Wide_Search : Boolean := True) + Wide_Search : Boolean := True; + Labels_As_Ref : Boolean := True) is Ptr : Positive renames File.Current_Line; Ali : String_Access renames File.Buffer; @@ -734,19 +769,6 @@ package body Xref_Lib is E_Name : Positive; -- Pointer to begin of entity name E_Type : Character; -- Type of current entity - procedure Skip_Line; - -- skip current line and continuation line - - procedure Skip_Line is - begin - loop - Parse_EOL (Ali, Ptr); - exit when Ali (Ptr) /= '.'; - end loop; - end Skip_Line; - - -- Start of processing for Get_Symbol_Name - begin -- Look for the X lines corresponding to unit Eun @@ -757,7 +779,7 @@ package body Xref_Lib is exit when E_Eun = Eun; end if; - Skip_Line; + Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True); end loop; -- Here we are in the right Ali section, we now look for the entity @@ -766,8 +788,10 @@ package body Xref_Lib is loop Parse_Number (Ali, Ptr, E_Line); E_Type := Ali (Ptr); + exit when Ali (Ptr) = EOF; Ptr := Ptr + 1; Parse_Number (Ali, Ptr, E_Col); + exit when Ali (Ptr) = EOF; Ptr := Ptr + 1; if Line = E_Line and then Col = E_Col then @@ -775,7 +799,8 @@ package body Xref_Lib is return Ali (E_Name .. Ptr - 1); end if; - Skip_Line; + Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True); + exit when Ali (Ptr) = EOF; end loop; -- We were not able to find the symbol, this should not happend but @@ -800,6 +825,17 @@ package body Xref_Lib is Ptr := Ptr + 1; end if; + -- Ignore some of the entities (labels,...) + + case E_Type is + when 'l' | 'L' | 'q' => + Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True); + return; + + when others => + null; + end case; + Parse_Number (Ali, Ptr, E_Col); E_Global := False; @@ -815,15 +851,13 @@ package body Xref_Lib is if (not Local_Symbols and not E_Global) or else (Pattern.Initialized - and then not Match (Pattern, Ali (E_Name .. Ptr - 1))) + and then not Match (Ali (E_Name .. Ptr - 1), Pattern.Entity)) or else (E_Name >= Ptr) then - -- Skip rest of this line and all continuation lines - - loop - Parse_EOL (Ali, Ptr); - exit when Ali (Ptr) /= '.'; - end loop; + Decl_Ref := Add_Declaration + (File.X_File, Ali (E_Name .. Ptr - 1), E_Line, E_Col, E_Type, + Remove_Only => True); + Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True); return; end if; @@ -836,7 +870,6 @@ package body Xref_Lib is or else Ali (Ptr) = '(' or else Ali (Ptr) = '{' then - -- Here we have a type derivation information. The format is -- <3|12I45> which means that the current entity is derived from the -- type defined in unit number 3, line 12 column 45. The pipe and @@ -893,15 +926,27 @@ package body Xref_Lib is -- on or if we want to output the type hierarchy if Der_Info or else Type_Tree then - Add_Parent - (Decl_Ref, - Get_Symbol_Name (P_Eun, P_Line, P_Column), - P_Line, - P_Column, - File.Dep.Table (P_Eun)); + declare + Symbol : constant String := + Get_Symbol_Name (P_Eun, P_Line, P_Column); + + begin + if Symbol /= "???" then + Add_Parent + (Decl_Ref, + Symbol, + P_Line, + P_Column, + File.Dep.Table (P_Eun)); + end if; + end; end if; - if Type_Tree then + if Type_Tree + and then (Pattern.File_Ref = Empty_File + or else + Pattern.File_Ref = Current_Xref_File (File)) + then Search_Parent_Tree : declare Pattern : Search_Pattern; -- Parent type pattern File_Pos_Backup : Positive; @@ -913,7 +958,7 @@ package body Xref_Lib is & ':' & Get_Gnatchop_File (File.Dep.Table (P_Eun)) & ':' & Get_Line (Get_Parent (Decl_Ref)) & ':' & Get_Column (Get_Parent (Decl_Ref)), - False); + False); -- No default match is needed to look for the parent type -- since we are using the fully qualified symbol name: @@ -921,34 +966,25 @@ package body Xref_Lib is Set_Default_Match (False); - -- The parent type is defined in the same unit as the - -- derived type. So we want to revisit the unit. + -- The parent hierarchy is defined in the same unit as + -- the derived type. So we want to revisit the unit. File_Pos_Backup := File.Current_Line; - if File.Dep.Table (P_Eun) = File_Ref then - - -- set file pointer at the start of the xref lines - - File.Current_Line := File.Xref_Line; - - Revisit_ALI_File : declare - File_Existed : Boolean; - File_Ref : File_Reference; - - begin - Add_To_Xref_File - (ALI_File_Name - (Get_File (File.Dep.Table (P_Eun))), - File_Existed, - File_Ref, - Visited => False); - Set_Unvisited (File_Ref); - end Revisit_ALI_File; - end if; - - Search (Pattern, - Local_Symbols, False, False, Der_Info, Type_Tree); + Skip_To_First_X_Line + (File, D_Lines => False, W_Lines => False); + + while File.Buffer (File.Current_Line) /= EOF loop + Parse_X_Filename (File); + Parse_Identifier_Info + (Pattern => Pattern, + File => File, + Local_Symbols => False, + Der_Info => Der_Info, + Type_Tree => True, + Wide_Search => False, + Labels_As_Ref => Labels_As_Ref); + end loop; File.Current_Line := File_Pos_Backup; end Search_Parent_Tree; @@ -968,6 +1004,7 @@ package body Xref_Lib is elsif Ali (Ptr) = '=' then declare P_Line, P_Column : Natural; + begin Ptr := Ptr + 1; Parse_Number (Ali, Ptr, P_Line); @@ -980,14 +1017,11 @@ package body Xref_Lib is if Wide_Search then declare - File_Existed : Boolean; File_Ref : File_Reference; File_Name : constant String := Get_Gnatchop_File (File.X_File); - begin - Add_To_Xref_File - (ALI_File_Name (File_Name), File_Existed, File_Ref, False); + File_Ref := Add_To_Xref_File (ALI_File_Name (File_Name), False); end; end if; @@ -1016,17 +1050,34 @@ package body Xref_Lib is Ptr := Ptr + 1; end if; + -- Imported entities might special indication as to their external + -- name: + -- 5U14*Foo2 5>20 6b<c,myfoo2>22 + + if R_Type = 'b' + and then Ali (Ptr) = '<' + then + while Ptr <= Ali'Last + and then Ali (Ptr) /= '>' + loop + Ptr := Ptr + 1; + end loop; + Ptr := Ptr + 1; + end if; + Parse_Number (Ali, Ptr, R_Col); -- Insert the reference or body in the table - Add_Reference (Decl_Ref, File_Ref, R_Line, R_Col, R_Type); + Add_Reference + (Decl_Ref, File_Ref, R_Line, R_Col, R_Type, Labels_As_Ref); -- Skip generic information, if any if Ali (Ptr) = '[' then declare Num_Nested : Integer := 1; + begin Ptr := Ptr + 1; while Num_Nested /= 0 loop @@ -1035,6 +1086,7 @@ package body Xref_Lib is elsif Ali (Ptr) = '[' then Num_Nested := Num_Nested + 1; end if; + Ptr := Ptr + 1; end loop; end; @@ -1056,9 +1108,9 @@ package body Xref_Lib is ------------------ procedure Parse_Number - (Source : access String; - Ptr : in out Positive; - Number : out Natural) + (Source : access String; + Ptr : in out Positive; + Number : out Natural) is begin -- Skip separators @@ -1069,8 +1121,8 @@ package body Xref_Lib is Number := 0; while Source (Ptr) in '0' .. '9' loop - Number := 10 * Number - + (Character'Pos (Source (Ptr)) - Character'Pos ('0')); + Number := + 10 * Number + (Character'Pos (Source (Ptr)) - Character'Pos ('0')); Ptr := Ptr + 1; end loop; end Parse_Number; @@ -1084,7 +1136,7 @@ package body Xref_Lib is Ptr : in out Positive; Token_Ptr : out Positive) is - In_Quotes : Boolean := False; + In_Quotes : Character := ASCII.NUL; begin -- Skip separators @@ -1097,18 +1149,30 @@ package body Xref_Lib is -- Find end-of-token - while (In_Quotes or else + while (In_Quotes /= ASCII.NUL or else not (Source (Ptr) = ' ' - or else Source (Ptr) = ASCII.HT - or else Source (Ptr) = '<' - or else Source (Ptr) = '{' - or else Source (Ptr) = '=' - or else Source (Ptr) = '(')) + or else Source (Ptr) = ASCII.HT + or else Source (Ptr) = '<' + or else Source (Ptr) = '{' + or else Source (Ptr) = '=' + or else Source (Ptr) = '(')) and then Source (Ptr) >= ' ' loop - if Source (Ptr) = '"' then - In_Quotes := not In_Quotes; - end if; + -- Double-quotes are used for operators + -- Simple-quotes are used for character constants, for instance when + -- they are found in an enumeration type "type A is ('+', '-');" + + case Source (Ptr) is + when '"' | ''' => + if In_Quotes = Source (Ptr) then + In_Quotes := ASCII.NUL; + elsif In_Quotes = ASCII.NUL then + In_Quotes := Source (Ptr); + end if; + + when others => + null; + end case; Ptr := Ptr + 1; end loop; @@ -1142,7 +1206,6 @@ package body Xref_Lib is Parse_EOL (Ali, Ptr); end loop; - end Parse_X_Filename; -------------------- @@ -1153,9 +1216,9 @@ package body Xref_Lib is (References : Boolean; Full_Path_Name : Boolean) is - Decl : Declaration_Reference := First_Declaration; - Ref1 : Reference; - Ref2 : Reference; + Decls : constant Declaration_Array_Access := Get_Declarations; + Decl : Declaration_Reference; + Arr : Reference_Array_Access; procedure Print_Ref (Ref : Reference; @@ -1170,20 +1233,26 @@ package body Xref_Lib is (Ref : Reference; Msg : String := " ") is + F : String_Access := + Osint.To_Host_File_Spec + (Get_Gnatchop_File (Ref, Full_Path_Name)); + Buffer : constant String := - Osint.To_Host_File_Spec - (Get_Gnatchop_File (Ref, Full_Path_Name)).all - & ":" & Get_Line (Ref) - & ":" & Get_Column (Ref) - & ": "; + F.all & + ":" & Get_Line (Ref) & + ":" & Get_Column (Ref) & + ": "; + Num_Blanks : Integer := Longest_File_Name + 10 - Buffer'Length; begin + Free (F); Num_Blanks := Integer'Max (0, Num_Blanks); Write_Line (Buffer & String'(1 .. Num_Blanks => ' ') & Msg & " " & Get_Symbol (Decl)); + if Get_Source_Line (Ref)'Length /= 0 then Write_Line (" " & Get_Source_Line (Ref)); end if; @@ -1192,35 +1261,45 @@ package body Xref_Lib is -- Start of processing for Print_Gnatfind begin - while Decl /= Empty_Declaration loop + for D in Decls'Range loop + Decl := Decls (D); + if Match (Decl) then -- Output the declaration declare Parent : constant Declaration_Reference := Get_Parent (Decl); + + F : String_Access := + Osint.To_Host_File_Spec + (Get_Gnatchop_File (Decl, Full_Path_Name)); + Buffer : constant String := - Osint.To_Host_File_Spec - (Get_Gnatchop_File (Decl, Full_Path_Name)).all - & ":" & Get_Line (Decl) - & ":" & Get_Column (Decl) - & ": "; + F.all & + ":" & Get_Line (Decl) & + ":" & Get_Column (Decl) & + ": "; + Num_Blanks : Integer := Longest_File_Name + 10 - Buffer'Length; begin + Free (F); Num_Blanks := Integer'Max (0, Num_Blanks); Write_Line (Buffer & String'(1 .. Num_Blanks => ' ') & "(spec) " & Get_Symbol (Decl)); if Parent /= Empty_Declaration then + F := Osint.To_Host_File_Spec (Get_Gnatchop_File (Parent)); Write_Line (Buffer & String'(1 .. Num_Blanks => ' ') & " derived from " & Get_Symbol (Parent) & " (" - & Osint.To_Host_File_Spec (Get_Gnatchop_File (Parent)).all + & F.all & ':' & Get_Line (Parent) & ':' & Get_Column (Parent) & ')'); + Free (F); end if; end; @@ -1230,30 +1309,25 @@ package body Xref_Lib is -- Output the body (sorted) - Ref1 := First_Body (Decl); - while Ref1 /= Empty_Reference loop - Print_Ref (Ref1, "(body)"); - Ref1 := Next (Ref1); + Arr := Get_References (Decl, Get_Bodies => True); + + for R in Arr'Range loop + Print_Ref (Arr (R), "(body)"); end loop; + Free (Arr); + if References then - Ref1 := First_Modif (Decl); - Ref2 := First_Reference (Decl); - while Ref1 /= Empty_Reference - or else Ref2 /= Empty_Reference - loop - if Compare (Ref1, Ref2) = LessThan then - Print_Ref (Ref1); - Ref1 := Next (Ref1); - else - Print_Ref (Ref2); - Ref2 := Next (Ref2); - end if; + Arr := Get_References + (Decl, Get_Writes => True, Get_Reads => True); + + for R in Arr'Range loop + Print_Ref (Arr (R)); end loop; + + Free (Arr); end if; end if; - - Decl := Next (Decl); end loop; end Print_Gnatfind; @@ -1262,41 +1336,48 @@ package body Xref_Lib is ------------------ procedure Print_Unused (Full_Path_Name : in Boolean) is - Decl : Declaration_Reference := First_Declaration; - Ref : Reference; + Decls : constant Declaration_Array_Access := Get_Declarations; + Decl : Declaration_Reference; + Arr : Reference_Array_Access; + F : String_Access; begin - while Decl /= Empty_Declaration loop - if First_Modif (Decl) = Empty_Reference - and then First_Reference (Decl) = Empty_Reference + for D in Decls'Range loop + Decl := Decls (D); + + if References_Count + (Decl, Get_Reads => True, Get_Writes => True) = 0 then + F := Osint.To_Host_File_Spec + (Get_Gnatchop_File (Decl, Full_Path_Name)); Write_Str (Get_Symbol (Decl) - & " " - & Get_Type (Decl) - & " " - & Osint.To_Host_File_Spec - (Get_Gnatchop_File (Decl, Full_Path_Name)).all - & ':' - & Get_Line (Decl) - & ':' - & Get_Column (Decl)); + & " (" + & Get_Full_Type (Decl) + & ") " + & F.all + & ':' + & Get_Line (Decl) + & ':' + & Get_Column (Decl)); + Free (F); -- Print the body if any - Ref := First_Body (Decl); + Arr := Get_References (Decl, Get_Bodies => True); - if Ref /= Empty_Reference then - Write_Line (' ' - & Osint.To_Host_File_Spec - (Get_Gnatchop_File (Ref, Full_Path_Name)).all - & ':' & Get_Line (Ref) - & ':' & Get_Column (Ref)); - else - Write_Eol; - end if; - end if; + for R in Arr'Range loop + F := Osint.To_Host_File_Spec + (Get_Gnatchop_File (Arr (R), Full_Path_Name)); + Write_Str (' ' + & F.all + & ':' & Get_Line (Arr (R)) + & ':' & Get_Column (Arr (R))); + Free (F); + end loop; - Decl := Next (Decl); + Write_Eol; + Free (Arr); + end if; end loop; end Print_Unused; @@ -1305,40 +1386,46 @@ package body Xref_Lib is -------------- procedure Print_Vi (Full_Path_Name : in Boolean) is - Tab : constant Character := ASCII.HT; - Decl : Declaration_Reference := First_Declaration; - Ref : Reference; + Tab : constant Character := ASCII.HT; + Decls : constant Declaration_Array_Access := + Get_Declarations (Sorted => False); + Decl : Declaration_Reference; + Arr : Reference_Array_Access; + F : String_Access; begin - while Decl /= Empty_Declaration loop - Write_Line (Get_Symbol (Decl) & Tab - & Get_File (Decl, Full_Path_Name) & Tab - & Get_Line (Decl)); + for D in Decls'Range loop + Decl := Decls (D); + + F := Osint.To_Host_File_Spec (Get_File (Decl, Full_Path_Name)); + Write_Line (Get_Symbol (Decl) & Tab & F.all & Tab & Get_Line (Decl)); + Free (F); -- Print the body if any - Ref := First_Body (Decl); + Arr := Get_References (Decl, Get_Bodies => True); - if Ref /= Empty_Reference then - Write_Line (Get_Symbol (Decl) & Tab - & Get_File (Ref, Full_Path_Name) - & Tab - & Get_Line (Ref)); - end if; + for R in Arr'Range loop + F := Osint.To_Host_File_Spec (Get_File (Arr (R), Full_Path_Name)); + Write_Line + (Get_Symbol (Decl) & Tab & F.all & Tab & Get_Line (Arr (R))); + Free (F); + end loop; + + Free (Arr); -- Print the modifications - Ref := First_Modif (Decl); + Arr := Get_References (Decl, Get_Writes => True, Get_Reads => True); - while Ref /= Empty_Reference loop - Write_Line (Get_Symbol (Decl) & Tab - & Get_File (Ref, Full_Path_Name) - & Tab - & Get_Line (Ref)); - Ref := Next (Ref); + for R in Arr'Range loop + F := Osint.To_Host_File_Spec (Get_File (Arr (R), Full_Path_Name)); + Write_Line + (Get_Symbol (Decl) & Tab & F.all & Tab & Get_Line (Arr (R))); + Free (F); end loop; - Decl := Next (Decl); + Free (Arr); end loop; end Print_Vi; @@ -1347,9 +1434,8 @@ package body Xref_Lib is ---------------- procedure Print_Xref (Full_Path_Name : in Boolean) is - Decl : Declaration_Reference := First_Declaration; - Ref : Reference; - File : File_Reference; + Decls : constant Declaration_Array_Access := Get_Declarations; + Decl : Declaration_Reference; Margin : constant := 10; -- Column where file names start @@ -1363,6 +1449,15 @@ package body Xref_Lib is procedure Print_Ref (Line, Column : String); -- The beginning of the output is aligned on a column multiple of 9 + procedure Print_List + (Decl : Declaration_Reference; + Msg : String; + Get_Reads : Boolean := False; + Get_Writes : Boolean := False; + Get_Bodies : Boolean := False); + -- Print a list of references. If the list is not empty, Msg will + -- be printed prior to the list. + ---------------- -- New_Line80 -- ---------------- @@ -1379,6 +1474,7 @@ package body Xref_Lib is procedure Print80 (S : in String) is Align : Natural := Margin - (Integer (Column) mod Margin); + begin if Align = Margin then Align := 0; @@ -1412,25 +1508,76 @@ package body Xref_Lib is Write_Str (String'(1 .. Align => ' ') & S); end Print_Ref; + ---------------- + -- Print_List -- + ---------------- + + procedure Print_List + (Decl : Declaration_Reference; + Msg : String; + Get_Reads : Boolean := False; + Get_Writes : Boolean := False; + Get_Bodies : Boolean := False) + is + Arr : Reference_Array_Access := + Get_References + (Decl, + Get_Writes => Get_Writes, + Get_Reads => Get_Reads, + Get_Bodies => Get_Bodies); + File : File_Reference := Empty_File; + F : String_Access; + + begin + if Arr'Length /= 0 then + Write_Eol; + Write_Str (Msg); + end if; + + for R in Arr'Range loop + if Get_File_Ref (Arr (R)) /= File then + if File /= Empty_File then + New_Line80; + end if; + + File := Get_File_Ref (Arr (R)); + F := Osint.To_Host_File_Spec + (Get_Gnatchop_File (Arr (R), Full_Path_Name)); + Write_Str (F.all & ' '); + Free (F); + end if; + + Print_Ref (Get_Line (Arr (R)), Get_Column (Arr (R))); + end loop; + + Free (Arr); + end Print_List; + + F : String_Access; + -- Start of processing for Print_Xref begin - while Decl /= Empty_Declaration loop + for D in Decls'Range loop + Decl := Decls (D); + Write_Str (Get_Symbol (Decl)); while Column < Type_Position loop Write_Char (' '); end loop; - Write_Line (Get_Full_Type (Get_Type (Decl))); + Write_Line (Get_Full_Type (Decl)); Write_Parent_Info : declare Parent : constant Declaration_Reference := Get_Parent (Decl); + begin if Parent /= Empty_Declaration then Write_Str (" Ptype: "); - Print80 - (Osint.To_Host_File_Spec (Get_Gnatchop_File (Parent)).all); + F := Osint.To_Host_File_Spec (Get_Gnatchop_File (Parent)); + Print80 (F.all); + Free (F); Print_Ref (Get_Line (Parent), Get_Column (Parent)); Print80 (" " & Get_Symbol (Parent)); Write_Eol; @@ -1438,129 +1585,22 @@ package body Xref_Lib is end Write_Parent_Info; Write_Str (" Decl: "); - Print80 - (Osint.To_Host_File_Spec - (Get_Gnatchop_File (Decl, Full_Path_Name)).all & ' '); + F := Osint.To_Host_File_Spec + (Get_Gnatchop_File (Decl, Full_Path_Name)); + Print80 (F.all & ' '); + Free (F); Print_Ref (Get_Line (Decl), Get_Column (Decl)); - -- Print the body if any - - Ref := First_Body (Decl); - - if Ref /= Empty_Reference then - Write_Eol; - Write_Str (" Body: "); - Print80 - (Osint.To_Host_File_Spec - (Get_Gnatchop_File (Ref, Full_Path_Name)).all & ' '); - Print_Ref (Get_Line (Ref), Get_Column (Ref)); - end if; - - -- Print the modifications if any - - Ref := First_Modif (Decl); - - if Ref /= Empty_Reference then - Write_Eol; - Write_Str (" Modi: "); - end if; - - File := Empty_File; - - while Ref /= Empty_Reference loop - if Get_File_Ref (Ref) /= File then - if File /= Empty_File then - New_Line80; - end if; - - File := Get_File_Ref (Ref); - Write_Str - (Get_Gnatchop_File (Ref, Full_Path_Name) & ' '); - Print_Ref (Get_Line (Ref), Get_Column (Ref)); - - else - Print_Ref (Get_Line (Ref), Get_Column (Ref)); - end if; - - Ref := Next (Ref); - end loop; - - -- Print the references - - Ref := First_Reference (Decl); - - if Ref /= Empty_Reference then - Write_Eol; - Write_Str (" Ref: "); - end if; - - File := Empty_File; - - while Ref /= Empty_Reference loop - if Get_File_Ref (Ref) /= File then - if File /= Empty_File then - New_Line80; - end if; - - File := Get_File_Ref (Ref); - Write_Str - (Osint.To_Host_File_Spec - (Get_Gnatchop_File (Ref, Full_Path_Name)).all & ' '); - Print_Ref (Get_Line (Ref), Get_Column (Ref)); - - else - Print_Ref (Get_Line (Ref), Get_Column (Ref)); - end if; - - Ref := Next (Ref); - end loop; - + Print_List + (Decl, " Body: ", Get_Bodies => True); + Print_List + (Decl, " Modi: ", Get_Writes => True); + Print_List + (Decl, " Ref: ", Get_Reads => True); Write_Eol; - Decl := Next (Decl); end loop; end Print_Xref; - --------------- - -- Read_File -- - --------------- - - procedure Read_File - (FD : File_Descriptor; - Contents : out String_Access; - Success : out Boolean) - is - Length : constant File_Offset := File_Offset (File_Length (FD)); - -- Include room for EOF char - - Buffer : String (1 .. Length + 1); - - This_Read : Integer; - Read_Ptr : File_Offset := 1; - - begin - - loop - This_Read := Read (FD, - A => Buffer (Read_Ptr)'Address, - N => Length + 1 - Read_Ptr); - Read_Ptr := Read_Ptr + Integer'Max (This_Read, 0); - exit when This_Read <= 0; - end loop; - - Buffer (Read_Ptr) := EOF; - Contents := new String'(Buffer (1 .. Read_Ptr)); - - -- Things aren't simple on VMS due to the plethora of file types - -- and organizations. It seems clear that there shouldn't be more - -- bytes read than are contained in the file though. - - if Hostparm.OpenVMS then - Success := Read_Ptr <= Length + 1; - else - Success := Read_Ptr = Length + 1; - end if; - end Read_File; - ------------ -- Search -- ------------ @@ -1576,10 +1616,10 @@ package body Xref_Lib is type String_Access is access String; procedure Free is new Unchecked_Deallocation (String, String_Access); - ALIfile : ALI_File; - File_Ref : File_Reference; - Strip_Num : Natural := 0; - Ali_Name : String_Access; + ALIfile : ALI_File; + File_Ref : File_Reference; + Strip_Num : Natural := 0; + Ali_Name : String_Access; begin -- If we want all the .ali files, then find them @@ -1606,7 +1646,8 @@ package body Xref_Lib is Ali_Name := new String' (Get_File (File_Ref, With_Dir => True, Strip => Strip_Num)); - -- Striped too many things... + -- Stripped too many things... + if Ali_Name.all = "" then if Get_Emit_Warning (File_Ref) then Set_Standard_Error; @@ -1618,29 +1659,45 @@ package body Xref_Lib is Free (Ali_Name); exit; - -- If not found, try the parent's ALI file (this is needed for - -- separate units and subprograms). + -- If not found, try the parent's ALI file (this is needed for + -- separate units and subprograms). + + -- Reset the cached directory first, in case the separate's + -- ALI file is not in the same directory. + elsif not File_Exists (Ali_Name.all) then Strip_Num := Strip_Num + 1; + Reset_Directory (File_Ref); + + -- Else we finally found it - -- Else we finally found it else exit; end if; end loop; + -- If we had to get the parent's ALI, insert it in the list as usual. + -- This is to avoid parsing it twice in case it has already been + -- parsed. + + if Ali_Name /= null and then Strip_Num /= 0 then + File_Ref := Add_To_Xref_File + (File_Name => Ali_Name.all, + Visited => False); + -- Now that we have a file name, parse it to find any reference to -- the entity. - if Ali_Name /= null + elsif Ali_Name /= null and then (Read_Only or else Is_Writable_File (Ali_Name.all)) then begin Open (Ali_Name.all, ALIfile); while ALIfile.Buffer (ALIfile.Current_Line) /= EOF loop Parse_X_Filename (ALIfile); - Parse_Identifier_Info (Pattern, ALIfile, Local_Symbols, - Der_Info, Type_Tree, Wide_Search); + Parse_Identifier_Info + (Pattern, ALIfile, Local_Symbols, + Der_Info, Type_Tree, Wide_Search, Labels_As_Ref => True); end loop; exception @@ -1668,10 +1725,13 @@ package body Xref_Lib is Read_Only : Boolean; Der_Info : Boolean) is - ALIfile : ALI_File; - File_Ref : File_Reference; + ALIfile : ALI_File; + File_Ref : File_Reference; Null_Pattern : Search_Pattern; + begin + Null_Pattern.Initialized := False; + loop -- Find the next unvisited file @@ -1680,22 +1740,24 @@ package body Xref_Lib is -- Search the object directories for the .ali file - if Read_Only - or else Is_Writable_File (Get_File (File_Ref, With_Dir => True)) - then - begin - Open (Get_File (File_Ref, With_Dir => True), ALIfile, True); + declare + F : constant String := Get_File (File_Ref, With_Dir => True); + + begin + if Read_Only or else Is_Writable_File (F) then + Open (F, ALIfile, True); while ALIfile.Buffer (ALIfile.Current_Line) /= EOF loop Parse_X_Filename (ALIfile); Parse_Identifier_Info - (Null_Pattern, ALIfile, Local_Symbols, Der_Info); + (Null_Pattern, ALIfile, Local_Symbols, Der_Info, + Labels_As_Ref => False); end loop; + end if; - exception - when No_Xref_Information => null; - end; - end if; + exception + when No_Xref_Information => null; + end; end loop; end Search_Xref; |