diff options
author | bosch <bosch@138bc75d-0d04-0410-961f-82ee72b054a4> | 2002-03-08 20:11:04 +0000 |
---|---|---|
committer | bosch <bosch@138bc75d-0d04-0410-961f-82ee72b054a4> | 2002-03-08 20:11:04 +0000 |
commit | f15731c43ae5e8cea424ea40f905c19afa1bd2e4 (patch) | |
tree | b584a79288c93215b05fb451943291ccd039388b /gcc/ada/prj-nmsc.adb | |
parent | 1d347c236ad815c77bd345611ed221b0bd6091de (diff) | |
download | gcc-f15731c43ae5e8cea424ea40f905c19afa1bd2e4.tar.gz |
* 41intnam.ads, 42intnam.ads, 4aintnam.ads, 4cintnam.ads,
4dintnam.ads, 4gintnam.ads, 4hintnam.ads, 4lintnam.ads,
4mintnam.ads, 4pintnam.ads, 4rintnam.ads, 4sintnam.ads,
4uintnam.ads, 4vcalend.adb, 4zintnam.ads, 52system.ads,
5amastop.adb, 5asystem.ads, 5ataprop.adb, 5atpopsp.adb,
5avxwork.ads, 5bosinte.adb, 5bsystem.ads, 5esystem.ads,
5fsystem.ads, 5ftaprop.adb, 5ginterr.adb, 5gmastop.adb,
5gsystem.ads, 5gtaprop.adb, 5gtasinf.adb, 5gtasinf.ads,
5hparame.ads, 5hsystem.ads, 5htaprop.adb, 5htraceb.adb,
5itaprop.adb, 5ksystem.ads, 5kvxwork.ads, 5lintman.adb,
5lsystem.ads, 5mvxwork.ads, 5ninmaop.adb, 5nosinte.ads,
5ntaprop.adb, 5ointerr.adb, 5omastop.adb, 5oosinte.adb,
5osystem.ads, 5otaprop.adb, 5otaspri.ads, 5pvxwork.ads,
5qtaprop.adb, 5sintman.adb, 5ssystem.ads, 5staprop.adb,
5stpopse.adb, 5svxwork.ads, 5tosinte.ads, 5uintman.adb,
5vasthan.adb, 5vinmaop.adb, 5vinterr.adb, 5vintman.adb,
5vmastop.adb, 5vparame.ads, 5vsystem.ads, 5vtaprop.adb,
5vtpopde.adb, 5wmemory.adb, 5wsystem.ads, 5wtaprop.adb,
5ysystem.ads, 5zinterr.adb, 5zintman.adb, 5zosinte.adb,
5zosinte.ads, 5zsystem.ads, 5ztaprop.adb, 6vcpp.adb, 6vcstrea.adb,
7sintman.adb, 7staprop.adb, 7stpopsp.adb, 9drpc.adb,
Make-lang.in, Makefile.in, a-caldel.adb, a-comlin.ads,
a-dynpri.adb, a-except.adb, a-except.ads, a-finali.adb,
a-ncelfu.ads, a-reatim.adb, a-retide.adb, a-stream.ads,
a-ststio.adb, a-ststio.ads, a-stwifi.adb, a-tags.adb, a-tasatt.adb,
a-textio.adb, a-tideau.adb, a-tiflau.adb, a-tigeau.adb,
a-tigeau.ads, a-tiinau.adb, a-timoau.adb, a-witeio.adb,
a-wtdeau.adb, a-wtenau.adb, a-wtflau.adb, a-wtgeau.adb,
a-wtgeau.ads, a-wtinau.adb, a-wtmoau.adb, ada-tree.def, ada-tree.h,
adaint.c, adaint.h, ali-util.adb, ali.adb, ali.ads, atree.adb,
atree.ads, atree.h, back_end.adb, bcheck.adb, bindgen.adb,
bindusg.adb, checks.adb, comperr.adb, config-lang.in, csets.adb,
csets.ads, cstand.adb, cstreams.c, debug.adb, debug.ads, decl.c,
einfo.adb, einfo.ads, einfo.h, elists.h, errout.adb, errout.ads,
eval_fat.adb, exp_aggr.adb, exp_attr.adb, exp_ch11.adb,
exp_ch12.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_ch9.adb, exp_ch9.ads, exp_dbug.adb, exp_dbug.ads, exp_disp.ads,
exp_dist.adb, exp_fixd.adb, exp_intr.adb, exp_pakd.adb,
exp_prag.adb, exp_strm.adb, exp_util.adb, exp_util.ads,
expander.adb, expect.c, fe.h, fmap.adb, fmap.ads, fname-uf.adb,
freeze.adb, frontend.adb, g-awk.adb, g-cgideb.adb, g-comlin.adb,
g-comlin.ads, g-debpoo.adb, g-dirope.adb, g-dirope.ads,
g-dyntab.adb, g-expect.adb, g-expect.ads, g-io.ads, g-io_aux.adb,
g-io_aux.ads, g-locfil.adb, g-locfil.ads, g-os_lib.adb,
g-os_lib.ads, g-regexp.adb, g-regpat.adb, g-socket.adb,
g-socket.ads, g-spipat.adb, g-table.adb, g-trasym.adb,
g-trasym.ads, gigi.h, gmem.c, gnat1drv.adb, gnatbind.adb, gnatbl.c,
gnatchop.adb, gnatcmd.adb, gnatdll.adb, gnatfind.adb, gnatlbr.adb,
gnatlink.adb, gnatls.adb, gnatmem.adb, gnatprep.adb, gnatvsn.ads,
gnatxref.adb, hlo.adb, hostparm.ads, i-cobol.adb, i-cpp.adb,
i-cstrea.ads, i-cstrin.adb, i-pacdec.adb, i-vxwork.ads,
impunit.adb, init.c, inline.adb, io-aux.c, layout.adb, lib-load.adb,
lib-util.adb, lib-writ.adb, lib-writ.ads, lib-xref.adb,
lib-xref.ads, lib.adb, lib.ads, make.adb, makeusg.adb, mdll.adb,
memroot.adb, misc.c, mlib-tgt.adb, mlib-utl.adb, mlib-utl.ads,
mlib.adb, namet.adb, namet.ads, namet.h, nlists.h, nmake.adb,
nmake.ads, nmake.adt, opt.adb, opt.ads, osint.adb, osint.ads,
output.adb, output.ads, par-ch2.adb, par-ch3.adb, par-ch5.adb,
par-prag.adb, par-tchk.adb, par-util.adb, par.adb, prj-attr.adb,
prj-dect.adb, prj-env.adb, prj-env.ads, prj-nmsc.adb, prj-part.adb,
prj-proc.adb, prj-strt.adb, prj-tree.adb, prj-tree.ads, prj.adb,
prj.ads, raise.c, raise.h, repinfo.adb, restrict.adb, restrict.ads,
rident.ads, rtsfind.adb, rtsfind.ads, s-arit64.adb, s-asthan.adb,
s-atacco.adb, s-atacco.ads, s-auxdec.adb, s-crc32.adb, s-crc32.ads,
s-direio.adb, s-fatgen.adb, s-fileio.adb, s-finimp.adb,
s-gloloc.adb, s-gloloc.ads, s-interr.adb, s-mastop.adb,
s-mastop.ads, s-memory.adb, s-parame.ads, s-parint.adb,
s-pooglo.adb, s-pooloc.adb, s-rpc.adb, s-secsta.adb, s-sequio.adb,
s-shasto.adb, s-soflin.adb, s-soflin.ads, s-stache.adb,
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-taprop.ads, s-tarest.adb, s-tasdeb.adb,
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-tassta.adb, s-tasuti.adb, s-tasuti.ads, s-tataat.adb,
s-tataat.ads, s-tpoben.adb, s-tpoben.ads, s-tpobop.adb,
s-tposen.adb, s-tposen.ads, s-traceb.adb, s-traceb.ads,
s-unstyp.ads, s-widenu.adb, scn-nlit.adb, scn.adb, sem.adb,
sem_aggr.adb, sem_attr.adb, sem_attr.ads, sem_case.adb,
sem_ch10.adb, sem_ch11.adb, sem_ch11.ads, sem_ch12.adb,
sem_ch13.adb, sem_ch13.ads, sem_ch2.adb, sem_ch3.adb, sem_ch3.ads,
sem_ch4.adb, sem_ch5.adb, sem_ch6.adb, sem_ch6.ads, sem_ch7.adb,
sem_ch8.adb, sem_ch8.ads, sem_ch9.adb, sem_disp.adb, sem_dist.adb,
sem_elab.adb, sem_elim.adb, sem_elim.ads, sem_eval.adb,
sem_intr.adb, sem_mech.adb, sem_prag.adb, sem_res.adb,
sem_type.adb, sem_util.adb, sem_util.ads, sem_vfpt.adb,
sem_warn.adb, sinfo.adb, sinfo.ads, sinfo.h, sinput-l.adb,
sinput-l.ads, sinput.adb, sinput.ads, snames.adb, snames.ads,
snames.h, sprint.adb, sprint.ads, stringt.adb, stringt.ads,
stringt.h, style.adb, switch.adb, switch.ads, sysdep.c, system.ads,
table.adb, targparm.adb, targparm.ads, targtyps.c, tbuild.adb,
tbuild.ads, tracebak.c, trans.c, tree_gen.adb, tree_io.adb,
treepr.adb, treepr.ads, treeprs.ads, treeprs.adt, ttypes.ads,
types.adb, types.ads, types.h, uintp.ads, urealp.ads, usage.adb,
utils.c, utils2.c, validsw.adb, xnmake.adb, xr_tabls.adb,
xr_tabls.ads, xref_lib.adb, xref_lib.ads : Merge in ACT changes.
* 1ssecsta.adb, 1ssecsta.ads, a-chlat9.ads, a-cwila9.ads,
g-enblsp.adb, g-md5.adb, g-md5.ads, gnatname.adb, gnatname.ads,
mkdir.c, osint-b.adb, osint-b.ads, osint-c.adb, osint-c.ads,
osint-l.adb, osint-l.ads, osint-m.adb, osint-m.ads : New files
* 3lsoccon.ads, 5qparame.ads, 5qvxwork.ads, 5smastop.adb,
5zparame.ads, gnatmain.adb, gnatmain.ads, gnatpsys.adb : Removed
* mdllfile.adb, mdllfile.ads, mdlltool.adb, mdlltool.ads : Renamed
to mdll-fil.ad[bs] and mdll-util.ad[bs]
* mdll-fil.adb, mdll-fil.ads, mdll-utl.adb, mdll-utl.ads : Renamed
from mdllfile.ad[bs] and mdlltool.ad[bs]
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@50451 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/prj-nmsc.adb')
-rw-r--r-- | gcc/ada/prj-nmsc.adb | 426 |
1 files changed, 296 insertions, 130 deletions
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 9f11f6f0170..317699fc75a 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -8,7 +8,7 @@ -- -- -- $Revision$ -- -- --- Copyright (C) 2000-2001 Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2002 Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -26,29 +26,34 @@ -- -- ------------------------------------------------------------------------------ +with Errout; +with Hostparm; +with MLib.Tgt; +with Namet; use Namet; +with Osint; use Osint; +with Output; use Output; +with Prj.Com; use Prj.Com; +with Prj.Env; use Prj.Env; +with Prj.Util; use Prj.Util; +with Snames; use Snames; +with Stringt; use Stringt; +with Types; use Types; + with Ada.Characters.Handling; use Ada.Characters.Handling; with Ada.Strings; use Ada.Strings; with Ada.Strings.Fixed; use Ada.Strings.Fixed; with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants; -with Errout; use Errout; + with GNAT.Case_Util; use GNAT.Case_Util; with GNAT.Directory_Operations; use GNAT.Directory_Operations; with GNAT.OS_Lib; use GNAT.OS_Lib; -with MLib.Tgt; -with Namet; use Namet; -with Osint; use Osint; -with Output; use Output; -with Prj.Com; use Prj.Com; -with Prj.Util; use Prj.Util; -with Snames; use Snames; -with Stringt; use Stringt; -with Types; use Types; package body Prj.Nmsc is - Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator; + Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator; - Error_Report : Put_Line_Access := null; + Error_Report : Put_Line_Access := null; + Current_Project : Project_Id := No_Project; procedure Check_Ada_Naming_Scheme (Naming : Naming_Data); -- Check that the package Naming is correct. @@ -76,17 +81,20 @@ package body Prj.Nmsc is -- specific SFN pragma is needed. If the file name corresponds to no -- unit, then Unit_Name will be No_Name. - function Is_Illegal_Append (This : String) return Boolean; - -- Returns True if the string This cannot be used as - -- a Specification_Append, a Body_Append or a Separate_Append. + function Is_Illegal_Suffix + (Suffix : String; + Dot_Replacement_Is_A_Single_Dot : Boolean) + return Boolean; + -- Returns True if the string Suffix cannot be used as + -- a spec suffix, a body suffix or a separate suffix. procedure Record_Source - (File_Name : Name_Id; - Path_Name : Name_Id; - Project : Project_Id; - Data : in out Project_Data; - Location : Source_Ptr; - Current_Source : in out String_List_Id); + (File_Name : Name_Id; + Path_Name : Name_Id; + Project : Project_Id; + Data : in out Project_Data; + Location : Source_Ptr; + Current_Source : in out String_List_Id); -- Put a unit in the list of units of a project, if the file name -- corresponds to a valid unit name. @@ -107,13 +115,6 @@ package body Prj.Nmsc is -- Returns the path name of a (non project) file. -- Returns an empty string if file cannot be found. - function Path_Name_Of - (File_Name : String_Id; - Directory : String_Id) - return String; - -- Same as above except that Directory is a String_Id instead - -- of a Name_Id. - --------------- -- Ada_Check -- --------------- @@ -164,7 +165,7 @@ package body Prj.Nmsc is Check_Ada_Name (Element.Index, Unit_Name); if Unit_Name = No_Name then - Error_Msg_Name_1 := Element.Index; + Errout.Error_Msg_Name_1 := Element.Index; Error_Msg ("{ is not a valid unit name.", Element.Value.Location); @@ -255,12 +256,12 @@ package body Prj.Nmsc is -- duplicate unit name. Record_Source - (File_Name => File_Name, - Path_Name => Path_Name, - Project => Project, - Data => Data, - Location => No_Location, - Current_Source => Current_Source); + (File_Name => File_Name, + Path_Name => Path_Name, + Project => Project, + Data => Data, + Location => No_Location, + Current_Source => Current_Source); else if Current_Verbosity = High then @@ -309,13 +310,21 @@ package body Prj.Nmsc is Source_Dir : String_List_Id := Data.Source_Dirs; Element : String_Element; Path_Name : GNAT.OS_Lib.String_Access; - Found : Boolean := False; File : Name_Id; + Path : Name_Id; + + Found : Boolean := False; + Fname : String := File_Name; begin + Canonical_Case_File_Name (Fname); + Name_Len := Fname'Length; + Name_Buffer (1 .. Name_Len) := Fname; + File := Name_Find; + if Current_Verbosity = High then Write_Str (" Checking """); - Write_Str (File_Name); + Write_Str (Fname); Write_Line ("""."); end if; @@ -332,7 +341,7 @@ package body Prj.Nmsc is Path_Name := Locate_Regular_File - (File_Name, + (Fname, Get_Name_String (Element.Value)); if Path_Name /= null then @@ -340,22 +349,19 @@ package body Prj.Nmsc is Write_Line ("OK"); end if; - Name_Len := File_Name'Length; - Name_Buffer (1 .. Name_Len) := File_Name; - File := Name_Find; Name_Len := Path_Name'Length; Name_Buffer (1 .. Name_Len) := Path_Name.all; + Path := Name_Find; - -- Register the source. Report an error if the file does not - -- correspond to a source. + -- Register the source if it is an Ada compilation unit.. Record_Source - (File_Name => File, - Path_Name => Name_Find, - Project => Project, - Data => Data, - Location => Location, - Current_Source => Current_Source); + (File_Name => File, + Path_Name => Path, + Project => Project, + Data => Data, + Location => Location, + Current_Source => Current_Source); Found := True; exit; @@ -368,6 +374,14 @@ package body Prj.Nmsc is end if; end loop; + -- It is an error if a source file names in a source list or + -- in a source list file is not found. + + if not Found then + Errout.Error_Msg_Name_1 := File; + Error_Msg ("source file { cannot be found", Location); + end if; + end Get_Path_Name_And_Record_Source; --------------------------- @@ -383,8 +397,6 @@ package body Prj.Nmsc is Last : Natural; Current_Source : String_List_Id := Nil_String; - Nmb_Errors : constant Nat := Errors_Detected; - begin if Current_Verbosity = High then Write_Str ("Opening """); @@ -403,7 +415,9 @@ package body Prj.Nmsc is Prj.Util.Get_Line (File, Line, Last); -- If the line is not empty and does not start with "--", - -- then it must contains a file name. + -- then it should contain a file name. However, if the + -- file name does not exist, it may be for another language + -- and we don't fail. if Last /= 0 and then (Last = 1 or else Line (1 .. 2) /= "--") @@ -412,7 +426,6 @@ package body Prj.Nmsc is (File_Name => Line (1 .. Last), Location => Location, Current_Source => Current_Source); - exit when Nmb_Errors /= Errors_Detected; end if; end loop; @@ -433,7 +446,8 @@ package body Prj.Nmsc is begin Language_Independent_Check (Project, Report_Error); - Error_Report := Report_Error; + Error_Report := Report_Error; + Current_Project := Project; Data := Projects.Table (Project); Languages := Prj.Util.Value_Of (Name_Languages, Data.Decl.Attributes); @@ -609,7 +623,7 @@ package body Prj.Nmsc is else Name_Len := Casing_Image'Length; Name_Buffer (1 .. Name_Len) := Casing_Image; - Error_Msg_Name_1 := Name_Find; + Errout.Error_Msg_Name_1 := Name_Find; Error_Msg ("{ is not a correct Casing", Casing_String.Location); @@ -806,7 +820,7 @@ package body Prj.Nmsc is begin if Source_File_Path_Name'Length = 0 then String_To_Name_Buffer (Source_List_File.Value); - Error_Msg_Name_1 := Name_Find; + Errout.Error_Msg_Name_1 := Name_Find; Error_Msg ("file with sources { does not exist", Source_List_File.Location); @@ -989,25 +1003,31 @@ package body Prj.Nmsc is -- - start with an alphanumeric -- - start with an '_' followed by an alphanumeric - if Is_Illegal_Append (Specification_Suffix) then - Error_Msg_Name_1 := Naming.Current_Spec_Suffix; + if Is_Illegal_Suffix + (Specification_Suffix, Dot_Replacement = ".") + then + Errout.Error_Msg_Name_1 := Naming.Current_Spec_Suffix; Error_Msg ("{ is illegal for Specification_Suffix", Naming.Spec_Suffix_Loc); end if; - if Is_Illegal_Append (Implementation_Suffix) then - Error_Msg_Name_1 := Naming.Current_Impl_Suffix; + if Is_Illegal_Suffix + (Implementation_Suffix, Dot_Replacement = ".") + then + Errout.Error_Msg_Name_1 := Naming.Current_Impl_Suffix; Error_Msg - ("% is illegal for Implementation_Suffix", + ("{ is illegal for Implementation_Suffix", Naming.Impl_Suffix_Loc); end if; if Implementation_Suffix /= Separate_Suffix then - if Is_Illegal_Append (Separate_Suffix) then - Error_Msg_Name_1 := Naming.Separate_Suffix; + if Is_Illegal_Suffix + (Separate_Suffix, Dot_Replacement = ".") + then + Errout.Error_Msg_Name_1 := Naming.Separate_Suffix; Error_Msg - ("{ is illegal for Separate_Append", + ("{ is illegal for Separate_Suffix", Naming.Sep_Suffix_Loc); end if; end if; @@ -1124,11 +1144,9 @@ package body Prj.Nmsc is Add ('"'); case Msg_Name is - when 1 => Add (Error_Msg_Name_1); - - when 2 => Add (Error_Msg_Name_2); - - when 3 => Add (Error_Msg_Name_3); + when 1 => Add (Errout.Error_Msg_Name_1); + when 2 => Add (Errout.Error_Msg_Name_2); + when 3 => Add (Errout.Error_Msg_Name_3); when others => null; end case; @@ -1141,7 +1159,7 @@ package body Prj.Nmsc is end loop; - Error_Report (Error_Buffer (1 .. Error_Last)); + Error_Report (Error_Buffer (1 .. Error_Last), Current_Project); end Error_Msg; --------------------- @@ -1252,6 +1270,13 @@ package body Prj.Nmsc is First : Positive := File'First; Last : Natural := File'Last; + Standard_GNAT : Boolean := + Naming.Current_Spec_Suffix = + Default_Ada_Spec_Suffix + and then + Naming.Current_Impl_Suffix = + Default_Ada_Impl_Suffix; + begin -- Check if the end of the file name is Specification_Append @@ -1333,6 +1358,8 @@ package body Prj.Nmsc is end if; Get_Name_String (Naming.Dot_Replacement); + Standard_GNAT := + Standard_GNAT and then Name_Buffer (1 .. Name_Len) = "-"; if Name_Buffer (1 .. Name_Len) /= "." then @@ -1414,6 +1441,36 @@ package body Prj.Nmsc is (Source => Src, Mapping => Lower_Case_Map); + -- In the standard GNAT naming scheme, check for special cases: + -- children or separates of A, G, I or S, and run time sources. + + if Standard_GNAT and then Src'Length >= 3 then + declare + S1 : constant Character := Src (Src'First); + S2 : constant Character := Src (Src'First + 1); + + begin + if S1 = 'a' or else S1 = 'g' + or else S1 = 'i' or else S1 = 's' + then + -- Children or separates of packages A, G, I or S + + if (Hostparm.OpenVMS and then S2 = '$') + or else (not Hostparm.OpenVMS and then S2 = '~') + then + Src (Src'First + 1) := '.'; + + -- If it is potentially a run time source, disable + -- filling of the mapping file to avoid warnings. + + elsif S2 = '.' then + Set_Mapping_File_Initial_State_To_Empty; + end if; + + end if; + end; + end if; + if Current_Verbosity = High then Write_Str (" "); Write_Line (Src); @@ -1432,18 +1489,48 @@ package body Prj.Nmsc is end Get_Unit; ----------------------- - -- Is_Illegal_Append -- + -- Is_Illegal_Suffix -- ----------------------- - function Is_Illegal_Append (This : String) return Boolean is + function Is_Illegal_Suffix + (Suffix : String; + Dot_Replacement_Is_A_Single_Dot : Boolean) + return Boolean + is begin - return This'Length = 0 - or else Is_Alphanumeric (This (This'First)) - or else Index (This, ".") = 0 - or else (This'Length >= 2 - and then This (This'First) = '_' - and then Is_Alphanumeric (This (This'First + 1))); - end Is_Illegal_Append; + if Suffix'Length = 0 + or else Is_Alphanumeric (Suffix (Suffix'First)) + or else Index (Suffix, ".") = 0 + or else (Suffix'Length >= 2 + and then Suffix (Suffix'First) = '_' + and then Is_Alphanumeric (Suffix (Suffix'First + 1))) + then + return True; + end if; + + -- If dot replacement is a single dot, and first character of + -- suffix is also a dot + + if Dot_Replacement_Is_A_Single_Dot + and then Suffix (Suffix'First) = '.' + then + for Index in Suffix'First + 1 .. Suffix'Last loop + + -- If there is another dot + + if Suffix (Index) = '.' then + + -- It is illegal to have a letter following the initial dot + + return Is_Letter (Suffix (Suffix'First + 1)); + end if; + end loop; + end if; + + -- Everything is OK + + return False; + end Is_Illegal_Suffix; -------------------------------- -- Language_Independent_Check -- @@ -1496,6 +1583,8 @@ package body Prj.Nmsc is The_Path_Last := The_Path_Last - 1; end if; + Canonical_Case_File_Name (The_Path); + if Current_Verbosity = High then Write_Str (" "); Write_Line (The_Path (The_Path'First .. The_Path_Last)); @@ -1545,11 +1634,13 @@ package body Prj.Nmsc is -- Avoid . and .. declare - Path_Name : constant String := + Path_Name : String := The_Path (The_Path'First .. The_Path_Last) & Name (1 .. Last); begin + Canonical_Case_File_Name (Path_Name); + if Is_Directory (Path_Name) then -- We have found a new subdirectory, @@ -1578,6 +1669,7 @@ package body Prj.Nmsc is end if; String_To_Name_Buffer (From); + Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); Directory := Name_Buffer (1 .. Name_Len); Directory_Id := Name_Find; @@ -1622,7 +1714,7 @@ package body Prj.Nmsc is begin if Root = No_Name then - Error_Msg_Name_1 := Base_Dir; + Errout.Error_Msg_Name_1 := Base_Dir; if Location = No_Location then Error_Msg ("{ is not a valid directory.", Data.Location); else @@ -1656,7 +1748,7 @@ package body Prj.Nmsc is begin if Path_Name = No_Name then - Error_Msg_Name_1 := Directory_Id; + Errout.Error_Msg_Name_1 := Directory_Id; if Location = No_Location then Error_Msg ("{ is not a valid directory", Data.Location); else @@ -1747,7 +1839,7 @@ package body Prj.Nmsc is Locate_Directory (Dir_Id, Data.Directory); if Data.Object_Directory = No_Name then - Error_Msg_Name_1 := Dir_Id; + Errout.Error_Msg_Name_1 := Dir_Id; Error_Msg ("the object directory { cannot be found", Data.Location); @@ -1803,7 +1895,7 @@ package body Prj.Nmsc is Locate_Directory (Dir_Id, Data.Directory); if Data.Exec_Directory = No_Name then - Error_Msg_Name_1 := Dir_Id; + Errout.Error_Msg_Name_1 := Dir_Id; Error_Msg ("the exec directory { cannot be found", Data.Location); @@ -2104,9 +2196,55 @@ package body Prj.Nmsc is -- Check Specification_Suffix - Data.Naming.Specification_Suffix := Util.Value_Of - (Name_Specification_Suffix, - Naming.Decl.Arrays); + declare + Spec_Suffixs : Array_Element_Id := + Util.Value_Of + (Name_Specification_Suffix, + Naming.Decl.Arrays); + Suffix : Array_Element_Id; + Element : Array_Element; + Suffix2 : Array_Element_Id; + + begin + -- If some suffixs have been specified, we make sure that + -- for each language for which a default suffix has been + -- specified, there is a suffix specified, either the one + -- in the project file or if there were noe, the default. + + if Spec_Suffixs /= No_Array_Element then + Suffix := Data.Naming.Specification_Suffix; + + while Suffix /= No_Array_Element loop + Element := Array_Elements.Table (Suffix); + Suffix2 := Spec_Suffixs; + + while Suffix2 /= No_Array_Element loop + exit when Array_Elements.Table (Suffix2).Index = + Element.Index; + Suffix2 := Array_Elements.Table (Suffix2).Next; + end loop; + + -- There is a registered default suffix, but no + -- suffix specified in the project file. + -- Add the default to the array. + + if Suffix2 = No_Array_Element then + Array_Elements.Increment_Last; + Array_Elements.Table (Array_Elements.Last) := + (Index => Element.Index, + Value => Element.Value, + Next => Spec_Suffixs); + Spec_Suffixs := Array_Elements.Last; + end if; + + Suffix := Element.Next; + end loop; + + -- Put the resulting array as the specification suffixs + + Data.Naming.Specification_Suffix := Spec_Suffixs; + end if; + end; declare Current : Array_Element_Id := Data.Naming.Specification_Suffix; @@ -2130,9 +2268,54 @@ package body Prj.Nmsc is -- Check Implementation_Suffix - Data.Naming.Implementation_Suffix := Util.Value_Of - (Name_Implementation_Suffix, - Naming.Decl.Arrays); + declare + Impl_Suffixs : Array_Element_Id := + Util.Value_Of + (Name_Implementation_Suffix, + Naming.Decl.Arrays); + Suffix : Array_Element_Id; + Element : Array_Element; + Suffix2 : Array_Element_Id; + begin + -- If some suffixs have been specified, we make sure that + -- for each language for which a default suffix has been + -- specified, there is a suffix specified, either the one + -- in the project file or if there were noe, the default. + + if Impl_Suffixs /= No_Array_Element then + Suffix := Data.Naming.Implementation_Suffix; + + while Suffix /= No_Array_Element loop + Element := Array_Elements.Table (Suffix); + Suffix2 := Impl_Suffixs; + + while Suffix2 /= No_Array_Element loop + exit when Array_Elements.Table (Suffix2).Index = + Element.Index; + Suffix2 := Array_Elements.Table (Suffix2).Next; + end loop; + + -- There is a registered default suffix, but no + -- suffix specified in the project file. + -- Add the default to the array. + + if Suffix2 = No_Array_Element then + Array_Elements.Increment_Last; + Array_Elements.Table (Array_Elements.Last) := + (Index => Element.Index, + Value => Element.Value, + Next => Impl_Suffixs); + Impl_Suffixs := Array_Elements.Last; + end if; + + Suffix := Element.Next; + end loop; + + -- Put the resulting array as the implementation suffixs + + Data.Naming.Implementation_Suffix := Impl_Suffixs; + end if; + end; declare Current : Array_Element_Id := Data.Naming.Implementation_Suffix; @@ -2154,6 +2337,17 @@ package body Prj.Nmsc is end loop; end; + -- Get the exceptions, if any + + Data.Naming.Specification_Exceptions := + Util.Value_Of + (Name_Specification_Exceptions, + In_Arrays => Naming.Decl.Arrays); + + Data.Naming.Implementation_Exceptions := + Util.Value_Of + (Name_Implementation_Exceptions, + In_Arrays => Naming.Decl.Arrays); end if; end; @@ -2221,34 +2415,6 @@ package body Prj.Nmsc is function Path_Name_Of (File_Name : String_Id; - Directory : String_Id) - return String - is - Result : String_Access; - - begin - String_To_Name_Buffer (File_Name); - - declare - The_File_Name : constant String := Name_Buffer (1 .. Name_Len); - - begin - String_To_Name_Buffer (Directory); - Result := Locate_Regular_File - (File_Name => The_File_Name, - Path => Name_Buffer (1 .. Name_Len)); - end; - - if Result = null then - return ""; - else - Canonical_Case_File_Name (Result.all); - return Result.all; - end if; - end Path_Name_Of; - - function Path_Name_Of - (File_Name : String_Id; Directory : Name_Id) return String is @@ -2274,12 +2440,12 @@ package body Prj.Nmsc is ------------------- procedure Record_Source - (File_Name : Name_Id; - Path_Name : Name_Id; - Project : Project_Id; - Data : in out Project_Data; - Location : Source_Ptr; - Current_Source : in out String_List_Id) + (File_Name : Name_Id; + Path_Name : Name_Id; + Project : Project_Id; + Data : in out Project_Data; + Location : Source_Ptr; + Current_Source : in out String_List_Id) is Unit_Name : Name_Id; Unit_Kind : Spec_Or_Body; @@ -2367,18 +2533,18 @@ package body Prj.Nmsc is The_Location := Projects.Table (Project).Location; end if; - Error_Msg_Name_1 := Unit_Name; + Errout.Error_Msg_Name_1 := Unit_Name; Error_Msg ("duplicate source {", The_Location); - Error_Msg_Name_1 := + Errout.Error_Msg_Name_1 := Projects.Table (The_Unit_Data.File_Names (Unit_Kind).Project).Name; - Error_Msg_Name_2 := + Errout.Error_Msg_Name_2 := The_Unit_Data.File_Names (Unit_Kind).Path; Error_Msg ("\ project file {, {", The_Location); - Error_Msg_Name_1 := Projects.Table (Project).Name; - Error_Msg_Name_2 := Path_Name; + Errout.Error_Msg_Name_1 := Projects.Table (Project).Name; + Errout.Error_Msg_Name_2 := Path_Name; Error_Msg ("\ project file {, {", The_Location); end if; |