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/g-os_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/g-os_lib.adb')
| -rw-r--r-- | gcc/ada/g-os_lib.adb | 783 |
1 files changed, 732 insertions, 51 deletions
diff --git a/gcc/ada/g-os_lib.adb b/gcc/ada/g-os_lib.adb index b92037b9d0d..24f6297b639 100644 --- a/gcc/ada/g-os_lib.adb +++ b/gcc/ada/g-os_lib.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1995-2002 Ada Core Technologies, Inc. -- +-- Copyright (C) 1995-2003 Ada Core Technologies, 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- -- @@ -26,10 +26,12 @@ -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- --- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ +with System.Case_Util; with System.Soft_Links; with Unchecked_Conversion; with System; use System; @@ -38,6 +40,18 @@ package body GNAT.OS_Lib is package SSL renames System.Soft_Links; + -- The following are used by Create_Temp_File + + Current_Temp_File_Name : String := "GNAT-TEMP-000000.TMP"; + -- Name of the temp file last created + + Temp_File_Name_Last_Digit : constant Positive := + Current_Temp_File_Name'Last - 4; + -- Position of the last digit in Current_Temp_File_Name + + Max_Attempts : constant := 100; + -- The maximum number of attempts to create a new temp file + ----------------------- -- Local Subprograms -- ----------------------- @@ -73,6 +87,42 @@ package body GNAT.OS_Lib is -- Converts a C String to an Ada String. We could do this making use of -- Interfaces.C.Strings but we prefer not to import that entire package + --------- + -- "<" -- + --------- + + function "<" (X, Y : OS_Time) return Boolean is + begin + return Long_Integer (X) < Long_Integer (Y); + end "<"; + + ---------- + -- "<=" -- + ---------- + + function "<=" (X, Y : OS_Time) return Boolean is + begin + return Long_Integer (X) <= Long_Integer (Y); + end "<="; + + --------- + -- ">" -- + --------- + + function ">" (X, Y : OS_Time) return Boolean is + begin + return Long_Integer (X) > Long_Integer (Y); + end ">"; + + ---------- + -- ">=" -- + ---------- + + function ">=" (X, Y : OS_Time) return Boolean is + begin + return Long_Integer (X) >= Long_Integer (Y); + end ">="; + ----------------- -- Args_Length -- ----------------- @@ -96,7 +146,7 @@ package body GNAT.OS_Lib is (Arg_String : String) return Argument_List_Access is - Max_Args : Integer := Arg_String'Length; + Max_Args : constant Integer := Arg_String'Length; New_Argv : Argument_List (1 .. Max_Args); New_Argc : Natural := 0; Idx : Integer; @@ -105,6 +155,8 @@ package body GNAT.OS_Lib is Idx := Arg_String'First; loop + exit when Idx > Arg_String'Last; + declare Quoted : Boolean := False; Backqd : Boolean := False; @@ -164,8 +216,6 @@ package body GNAT.OS_Lib is Idx := Idx + 1; end loop; end; - - exit when Idx > Arg_String'Last; end loop; return new Argument_List'(New_Argv (1 .. New_Argc)); @@ -176,6 +226,7 @@ package body GNAT.OS_Lib is --------------------- function C_String_Length (S : Address) return Integer is + function Strlen (S : Address) return Integer; pragma Import (C, Strlen, "strlen"); @@ -187,6 +238,373 @@ package body GNAT.OS_Lib is end if; end C_String_Length; + ----------- + -- Close -- + ----------- + + procedure Close (FD : File_Descriptor) is + procedure C_Close (FD : File_Descriptor); + pragma Import (C, C_Close, "close"); + begin + C_Close (FD); + end Close; + + procedure Close (FD : File_Descriptor; Status : out Boolean) is + function C_Close (FD : File_Descriptor) return Integer; + pragma Import (C, C_Close, "close"); + begin + Status := (C_Close (FD) = 0); + end Close; + + --------------- + -- Copy_File -- + --------------- + + procedure Copy_File + (Name : String; + Pathname : String; + Success : out Boolean; + Mode : Copy_Mode := Copy; + Preserve : Attribute := Time_Stamps) + is + From : File_Descriptor; + To : File_Descriptor; + + Copy_Error : exception; + -- Internal exception raised to signal error in copy + + function Build_Path (Dir : String; File : String) return String; + -- Returns pathname Dir catenated with File adding the directory + -- separator only if needed. + + procedure Copy (From, To : File_Descriptor); + -- Read data from From and place them into To. In both cases the + -- operations uses the current file position. Raises Constraint_Error + -- if a problem occurs during the copy. + + procedure Copy_To (To_Name : String); + -- Does a straight copy from source to designated destination file + + ---------------- + -- Build_Path -- + ---------------- + + function Build_Path (Dir : String; File : String) return String is + Res : String (1 .. Dir'Length + File'Length + 1); + + Base_File_Ptr : Integer; + -- The base file name is File (Base_File_Ptr + 1 .. File'Last) + + function Is_Dirsep (C : Character) return Boolean; + pragma Inline (Is_Dirsep); + -- Returns True if C is a directory separator. On Windows we + -- handle both styles of directory separator. + + --------------- + -- Is_Dirsep -- + --------------- + + function Is_Dirsep (C : Character) return Boolean is + begin + return C = Directory_Separator or else C = '/'; + end Is_Dirsep; + + begin + -- Find base file name + + Base_File_Ptr := File'Last; + while Base_File_Ptr >= File'First loop + exit when Is_Dirsep (File (Base_File_Ptr)); + Base_File_Ptr := Base_File_Ptr - 1; + end loop; + + declare + Base_File : String renames + File (Base_File_Ptr + 1 .. File'Last); + + begin + Res (1 .. Dir'Length) := Dir; + + if Is_Dirsep (Dir (Dir'Last)) then + Res (Dir'Length + 1 .. Dir'Length + Base_File'Length) := + Base_File; + return Res (1 .. Dir'Length + Base_File'Length); + + else + Res (Dir'Length + 1) := Directory_Separator; + Res (Dir'Length + 2 .. Dir'Length + 1 + Base_File'Length) := + Base_File; + return Res (1 .. Dir'Length + 1 + Base_File'Length); + end if; + end; + end Build_Path; + + ---------- + -- Copy -- + ---------- + + procedure Copy (From, To : File_Descriptor) is + Buf_Size : constant := 200_000; + Buffer : array (1 .. Buf_Size) of Character; + R : Integer; + W : Integer; + + Status_From : Boolean; + Status_To : Boolean; + -- Statuses for the calls to Close + + begin + if From = Invalid_FD or else To = Invalid_FD then + raise Copy_Error; + end if; + + loop + R := Read (From, Buffer (1)'Address, Buf_Size); + + -- For VMS, the buffer may not be full. So, we need to try again + -- until there is nothing to read. + + exit when R = 0; + + W := Write (To, Buffer (1)'Address, R); + + if W < R then + + -- Problem writing data, could be a disk full. Close files + -- without worrying about status, since we are raising a + -- Copy_Error exception in any case. + + Close (From, Status_From); + Close (To, Status_To); + + raise Copy_Error; + end if; + end loop; + + Close (From, Status_From); + Close (To, Status_To); + + if not (Status_From and Status_To) then + raise Copy_Error; + end if; + end Copy; + + ------------- + -- Copy_To -- + ------------- + + procedure Copy_To (To_Name : String) is + + function Copy_Attributes + (From, To : System.Address; + Mode : Integer) + return Integer; + pragma Import (C, Copy_Attributes, "__gnat_copy_attribs"); + -- Mode = 0 - copy only time stamps. + -- Mode = 1 - copy time stamps and read/write/execute attributes + + C_From : String (1 .. Name'Length + 1); + C_To : String (1 .. To_Name'Length + 1); + + begin + From := Open_Read (Name, Binary); + To := Create_File (To_Name, Binary); + Copy (From, To); + + -- Copy attributes + + C_From (1 .. Name'Length) := Name; + C_From (C_From'Last) := ASCII.Nul; + + C_To (1 .. To_Name'Length) := To_Name; + C_To (C_To'Last) := ASCII.Nul; + + case Preserve is + + when Time_Stamps => + if Copy_Attributes (C_From'Address, C_To'Address, 0) = -1 then + raise Copy_Error; + end if; + + when Full => + if Copy_Attributes (C_From'Address, C_To'Address, 1) = -1 then + raise Copy_Error; + end if; + + when None => + null; + end case; + + end Copy_To; + + -- Start of processing for Copy_File + + begin + Success := True; + + -- The source file must exist + + if not Is_Regular_File (Name) then + raise Copy_Error; + end if; + + -- The source file exists + + case Mode is + + -- Copy case, target file must not exist + + when Copy => + + -- If the target file exists, we have an error + + if Is_Regular_File (Pathname) then + raise Copy_Error; + + -- Case of target is a directory + + elsif Is_Directory (Pathname) then + declare + Dest : constant String := Build_Path (Pathname, Name); + + begin + -- If the target file exists, we have an error + -- otherwise do the copy. + + if Is_Regular_File (Dest) then + raise Copy_Error; + else + Copy_To (Dest); + end if; + end; + + -- Case of normal copy to file (destination does not exist) + + else + Copy_To (Pathname); + end if; + + -- Overwrite case, destination file may or may not exist + + when Overwrite => + if Is_Directory (Pathname) then + Copy_To (Build_Path (Pathname, Name)); + else + Copy_To (Pathname); + end if; + + -- Appending case, destination file may or may not exist + + when Append => + + -- Appending to existing file + + if Is_Regular_File (Pathname) then + + -- Append mode and destination file exists, append data + -- at the end of Pathname. + + From := Open_Read (Name, Binary); + To := Open_Read_Write (Pathname, Binary); + Lseek (To, 0, Seek_End); + + Copy (From, To); + + -- Appending to directory, not allowed + + elsif Is_Directory (Pathname) then + raise Copy_Error; + + -- Appending when target file does not exist + + else + Copy_To (Pathname); + end if; + end case; + + -- All error cases are caught here + + exception + when Copy_Error => + Success := False; + end Copy_File; + + procedure Copy_File + (Name : C_File_Name; + Pathname : C_File_Name; + Success : out Boolean; + Mode : Copy_Mode := Copy; + Preserve : Attribute := Time_Stamps) + is + Ada_Name : String_Access := + To_Path_String_Access + (Name, C_String_Length (Name)); + + Ada_Pathname : String_Access := + To_Path_String_Access + (Pathname, C_String_Length (Pathname)); + + begin + Copy_File (Ada_Name.all, Ada_Pathname.all, Success, Mode, Preserve); + Free (Ada_Name); + Free (Ada_Pathname); + end Copy_File; + + ---------------------- + -- Copy_Time_Stamps -- + ---------------------- + + procedure Copy_Time_Stamps (Source, Dest : String; Success : out Boolean) is + + function Copy_Attributes + (From, To : System.Address; + Mode : Integer) + return Integer; + pragma Import (C, Copy_Attributes, "__gnat_copy_attribs"); + -- Mode = 0 - copy only time stamps. + -- Mode = 1 - copy time stamps and read/write/execute attributes + + begin + if Is_Regular_File (Source) and then Is_Writable_File (Dest) then + declare + C_Source : String (1 .. Source'Length + 1); + C_Dest : String (1 .. Dest'Length + 1); + begin + C_Source (1 .. C_Source'Length) := Source; + C_Source (C_Source'Last) := ASCII.Nul; + + C_Dest (1 .. C_Dest'Length) := Dest; + C_Dest (C_Dest'Last) := ASCII.Nul; + + if Copy_Attributes (C_Source'Address, C_Dest'Address, 0) = -1 then + Success := False; + else + Success := True; + end if; + end; + + else + Success := False; + end if; + end Copy_Time_Stamps; + + procedure Copy_Time_Stamps + (Source, Dest : C_File_Name; + Success : out Boolean) + is + Ada_Source : String_Access := + To_Path_String_Access + (Source, C_String_Length (Source)); + + Ada_Dest : String_Access := + To_Path_String_Access + (Dest, C_String_Length (Dest)); + begin + Copy_Time_Stamps (Ada_Source.all, Ada_Dest.all, Success); + Free (Ada_Source); + Free (Ada_Dest); + end Copy_Time_Stamps; + ----------------- -- Create_File -- ----------------- @@ -269,6 +687,99 @@ package body GNAT.OS_Lib is FD := Open_New_Temp (Name'Address, Binary); end Create_Temp_File; + procedure Create_Temp_File + (FD : out File_Descriptor; + Name : out String_Access) + is + Pos : Positive; + Attempts : Natural := 0; + Current : String (Current_Temp_File_Name'Range); + + begin + -- Loop until a new temp file can be created + + File_Loop : loop + Locked : begin + -- We need to protect global variable Current_Temp_File_Name + -- against concurrent access by different tasks. + + SSL.Lock_Task.all; + + -- Start at the last digit + + Pos := Temp_File_Name_Last_Digit; + + Digit_Loop : + loop + -- Increment the digit by one + + case Current_Temp_File_Name (Pos) is + when '0' .. '8' => + Current_Temp_File_Name (Pos) := + Character'Succ (Current_Temp_File_Name (Pos)); + exit Digit_Loop; + + when '9' => + + -- For 9, set the digit to 0 and go to the previous digit + + Current_Temp_File_Name (Pos) := '0'; + Pos := Pos - 1; + + when others => + + -- If it is not a digit, then there are no available + -- temp file names. Return Invalid_FD. There is almost + -- no that this code will be ever be executed, since + -- it would mean that there are one million temp files + -- in the same directory! + + SSL.Unlock_Task.all; + FD := Invalid_FD; + Name := null; + exit File_Loop; + end case; + end loop Digit_Loop; + + Current := Current_Temp_File_Name; + + -- We can now release the lock, because we are no longer + -- accessing Current_Temp_File_Name. + + SSL.Unlock_Task.all; + + exception + when others => + SSL.Unlock_Task.all; + raise; + end Locked; + + -- Attempt to create the file + + FD := Create_New_File (Current, Binary); + + if FD /= Invalid_FD then + Name := new String'(Current); + exit File_Loop; + end if; + + if not Is_Regular_File (Current) then + + -- If the file does not already exist and we are unable to create + -- it, we give up after Max_Attempts. Otherwise, we try again with + -- the next available file name. + + Attempts := Attempts + 1; + + if Attempts >= Max_Attempts then + FD := Invalid_FD; + Name := null; + exit File_Loop; + end if; + end if; + end loop File_Loop; + end Create_Temp_File; + ----------------- -- Delete_File -- ----------------- @@ -323,25 +834,6 @@ package body GNAT.OS_Lib is return File_Time_Stamp (F_Name'Address); end File_Time_Stamp; - ---------- - -- Free -- - ---------- - - procedure Free (Arg : in out String_List_Access) is - X : String_Access; - - procedure Free_Array is new Unchecked_Deallocation - (Object => String_List, Name => String_List_Access); - - begin - for J in Arg'Range loop - X := Arg (J); - Free (X); - end loop; - - Free_Array (Arg); - end Free; - --------------------------- -- Get_Debuggable_Suffix -- --------------------------- @@ -434,9 +926,9 @@ package body GNAT.OS_Lib is procedure Strncpy (Astring_Addr, Cstring : Address; N : Integer); pragma Import (C, Strncpy, "strncpy"); - Env_Value_Ptr : Address; - Env_Value_Length : Integer; - F_Name : String (1 .. Name'Length + 1); + Env_Value_Ptr : aliased Address; + Env_Value_Length : aliased Integer; + F_Name : aliased String (1 .. Name'Length + 1); Result : String_Access; begin @@ -666,6 +1158,27 @@ package body GNAT.OS_Lib is end Is_Regular_File; ---------------------- + -- Is_Readable_File -- + ---------------------- + + function Is_Readable_File (Name : C_File_Name) return Boolean is + function Is_Readable_File (Name : Address) return Integer; + pragma Import (C, Is_Readable_File, "__gnat_is_readable_file"); + + begin + return Is_Readable_File (Name) /= 0; + end Is_Readable_File; + + function Is_Readable_File (Name : String) return Boolean is + F_Name : String (1 .. Name'Length + 1); + + begin + F_Name (1 .. Name'Length) := Name; + F_Name (F_Name'Last) := ASCII.NUL; + return Is_Readable_File (F_Name'Address); + end Is_Readable_File; + + ---------------------- -- Is_Writable_File -- ---------------------- @@ -686,6 +1199,27 @@ package body GNAT.OS_Lib is return Is_Writable_File (F_Name'Address); end Is_Writable_File; + ---------------------- + -- Is_Symbolic_Link -- + ---------------------- + + function Is_Symbolic_Link (Name : C_File_Name) return Boolean is + function Is_Symbolic_Link (Name : Address) return Integer; + pragma Import (C, Is_Symbolic_Link, "__gnat_is_symbolic_link"); + + begin + return Is_Symbolic_Link (Name) /= 0; + end Is_Symbolic_Link; + + function Is_Symbolic_Link (Name : String) return Boolean is + F_Name : String (1 .. Name'Length + 1); + + begin + F_Name (1 .. Name'Length) := Name; + F_Name (F_Name'Last) := ASCII.NUL; + return Is_Symbolic_Link (F_Name'Address); + end Is_Symbolic_Link; + ------------------------- -- Locate_Exec_On_Path -- ------------------------- @@ -797,10 +1331,11 @@ package body GNAT.OS_Lib is procedure Normalize_Arguments (Args : in out Argument_List) is procedure Quote_Argument (Arg : in out String_Access); - -- Add quote around argument if it contains spaces. + -- Add quote around argument if it contains spaces - Argument_Needs_Quote : Boolean; - pragma Import (C, Argument_Needs_Quote, "__gnat_argument_needs_quote"); + C_Argument_Needs_Quote : Integer; + pragma Import (C, C_Argument_Needs_Quote, "__gnat_argument_needs_quote"); + Argument_Needs_Quote : constant Boolean := C_Argument_Needs_Quote /= 0; -------------------- -- Quote_Argument -- @@ -826,6 +1361,7 @@ package body GNAT.OS_Lib is Res (J) := '\'; J := J + 1; Res (J) := '"'; + Quote_Needed := True; elsif Arg (K) = ' ' then Res (J) := Arg (K); @@ -839,10 +1375,28 @@ package body GNAT.OS_Lib is if Quote_Needed then - -- Ending quote + -- If null terminated string, put the quote before - J := J + 1; - Res (J) := '"'; + if Res (J) = ASCII.Nul then + Res (J) := '"'; + J := J + 1; + Res (J) := ASCII.Nul; + + -- If argument is terminated by '\', then double it. Otherwise + -- the ending quote will be taken as-is. This is quite strange + -- spawn behavior from Windows, but this is what we see! + + else + if Res (J) = '\' then + J := J + 1; + Res (J) := '\'; + end if; + + -- Ending quote + + J := J + 1; + Res (J) := '"'; + end if; declare Old : String_Access := Arg; @@ -859,7 +1413,7 @@ package body GNAT.OS_Lib is begin if Argument_Needs_Quote then for K in Args'Range loop - if Args (K) /= null then + if Args (K) /= null and then Args (K)'Length /= 0 then Quote_Argument (Args (K)); end if; end loop; @@ -871,9 +1425,11 @@ package body GNAT.OS_Lib is ------------------------ function Normalize_Pathname - (Name : String; - Directory : String := "") - return String + (Name : String; + Directory : String := ""; + Resolve_Links : Boolean := True; + Case_Sensitive : Boolean := True) + return String is Max_Path : Integer; pragma Import (C, Max_Path, "__gnat_max_path_len"); @@ -884,6 +1440,9 @@ package body GNAT.OS_Lib is Length : System.Address); pragma Import (C, Get_Current_Dir, "__gnat_get_current_dir"); + function Change_Dir (Dir_Name : String) return Integer; + pragma Import (C, Change_Dir, "chdir"); + Path_Buffer : String (1 .. Max_Path + Max_Path + 2); End_Path : Natural := 0; Link_Buffer : String (1 .. Max_Path + 2); @@ -894,6 +1453,15 @@ package body GNAT.OS_Lib is Max_Iterations : constant := 500; + function Get_File_Names_Case_Sensitive return Integer; + pragma Import + (C, Get_File_Names_Case_Sensitive, + "__gnat_get_file_names_case_sensitive"); + + Fold_To_Lower_Case : constant Boolean := + not Case_Sensitive + and then Get_File_Names_Case_Sensitive = 0; + function Readlink (Path : System.Address; Buf : System.Address; @@ -917,8 +1485,8 @@ package body GNAT.OS_Lib is function Strlen (S : System.Address) return Integer; pragma Import (C, Strlen, "strlen"); - function Get_Directory return String; - -- If Directory is not empty, return it, adding a directory separator + function Get_Directory (Dir : String) return String; + -- If Dir is not empty, return it, adding a directory separator -- if not already present, otherwise return current working directory -- with terminating directory separator. @@ -933,19 +1501,19 @@ package body GNAT.OS_Lib is -- Get_Directory -- ------------------- - function Get_Directory return String is + function Get_Directory (Dir : String) return String is begin -- Directory given, add directory separator if needed - if Directory'Length > 0 then - if Directory (Directory'Length) = Directory_Separator then + if Dir'Length > 0 then + if Dir (Dir'Length) = Directory_Separator then return Directory; else declare - Result : String (1 .. Directory'Length + 1); + Result : String (1 .. Dir'Length + 1); begin - Result (1 .. Directory'Length) := Directory; + Result (1 .. Dir'Length) := Dir; Result (Result'Length) := Directory_Separator; return Result; end; @@ -971,7 +1539,7 @@ package body GNAT.OS_Lib is end if; end Get_Directory; - Reference_Dir : constant String := Get_Directory; + Reference_Dir : constant String := Get_Directory (Directory); -- Current directory name specified ----------------- @@ -979,6 +1547,9 @@ package body GNAT.OS_Lib is ----------------- function Final_Value (S : String) return String is + S1 : String := S; + -- We may need to fold S to lower case, so we need a variable + begin -- Interix has the non standard notion of disk drive -- indicated by two '/' followed by a capital letter @@ -998,11 +1569,23 @@ package body GNAT.OS_Lib is begin Result (1) := '/'; Result (2 .. Result'Last) := S; + + if Fold_To_Lower_Case then + System.Case_Util.To_Lower (Result); + end if; + return Result; + end; else - return S; + + if Fold_To_Lower_Case then + System.Case_Util.To_Lower (S1); + end if; + + return S1; + end if; end Final_Value; @@ -1042,8 +1625,8 @@ package body GNAT.OS_Lib is Unchecked_Conversion (Source => Address, Target => Path_String_Access); - Path_Access : Path_String_Access := - Address_To_Access (Canonical_File_Addr); + Path_Access : constant Path_String_Access := + Address_To_Access (Canonical_File_Addr); begin Path_Buffer (1 .. Canonical_File_Len) := Path_Access.all; @@ -1062,6 +1645,85 @@ package body GNAT.OS_Lib is end loop; end if; + -- Resolving logical names from VMS. + -- If we have a Unix path on VMS such as /temp/..., and TEMP is a + -- logical name, we need to resolve this logical name. + -- As we have no means to know if we are on VMS, we need to do that + -- for absolute paths starting with '/'. + -- We find the directory, change to it, get the current directory, + -- and change the directory to this value. + + if Path_Buffer (1) = '/' then + declare + Cur_Dir : String := Get_Directory (""); + -- Save the current directory, so that we can change dir back to + -- it. It is not a constant, because the last character (a + -- directory separator) is changed to ASCII.NUL to call the C + -- function chdir. + + Path : String := Path_Buffer (1 .. End_Path + 1); + -- Copy of the current path. One character is added that may be + -- set to ASCII.NUL to call chdir. + + Pos : Positive := End_Path; + -- Position of the last directory separator ('/') + + Status : Integer; + -- Value returned by chdir + + begin + -- Look for the last '/' + + while Path (Pos) /= '/' loop + Pos := Pos - 1; + end loop; + + -- Get the previous character that is not a '/' + + while Pos > 1 and then Path (Pos) = '/' loop + Pos := Pos - 1; + end loop; + + -- If we are at the start of the path, take the full path. + -- It may be a file in the root directory, but it may also be + -- a subdirectory of the root directory. + + if Pos = 1 then + Pos := End_Path; + end if; + + -- Add the ASCII.NUL to be able to call the C function chdir + Path (Pos + 1) := ASCII.NUL; + + Status := Change_Dir (Path (1 .. Pos + 1)); + + -- If Status is not zero, then we do nothing: this is a file + -- path or it is not a valid directory path. + + if Status = 0 then + declare + New_Dir : constant String := Get_Directory (""); + -- The directory path + + New_Path : String (1 .. New_Dir'Length + End_Path - Pos); + -- The new complete path, that is built below + + begin + New_Path (1 .. New_Dir'Length) := New_Dir; + New_Path (New_Dir'Length + 1 .. New_Path'Last) := + Path_Buffer (Pos + 1 .. End_Path); + End_Path := New_Path'Length; + Path_Buffer (1 .. End_Path) := New_Path; + end; + + -- Back to where we were before + + Cur_Dir (Cur_Dir'Last) := ASCII.NUL; + Status := Change_Dir (Cur_Dir); + end if; + end; + end if; + -- Start the conversions -- If this is not finished after Max_Iterations, give up and @@ -1092,6 +1754,15 @@ package body GNAT.OS_Lib is Start := Last + 1; Finish := Last; + -- Ensure that Windows network drives are kept, e.g: \\server\drive-c + + if Start = 2 + and then Directory_Separator = '\' + and then Path_Buffer (1 .. 2) = "\\" + then + Start := 3; + end if; + -- If we have traversed the full pathname, return it if Start > End_Path then @@ -1127,7 +1798,13 @@ package body GNAT.OS_Lib is if Last = 1 then return (1 => Directory_Separator); else + + if Fold_To_Lower_Case then + System.Case_Util.To_Lower (Path_Buffer (1 .. Last - 1)); + end if; + return Path_Buffer (1 .. Last - 1); + end if; else @@ -1173,9 +1850,9 @@ package body GNAT.OS_Lib is -- Check if current field is a symbolic link - else + elsif Resolve_Links then declare - Saved : Character := Path_Buffer (Finish + 1); + Saved : constant Character := Path_Buffer (Finish + 1); begin Path_Buffer (Finish + 1) := ASCII.NUL; @@ -1209,6 +1886,9 @@ package body GNAT.OS_Lib is Link_Buffer (1 .. Status); end if; end if; + + else + Last := Finish + 1; end if; end loop; @@ -1503,7 +2183,8 @@ package body GNAT.OS_Lib is Unchecked_Conversion (Source => Address, Target => Path_String_Access); - Path_Access : Path_String_Access := Address_To_Access (Path_Addr); + Path_Access : constant Path_String_Access := + Address_To_Access (Path_Addr); Return_Val : String_Access; |