diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-06-06 10:19:40 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-06-06 10:19:40 +0000 |
commit | c2052d920b49395f766c1a47448d02f8896296e2 (patch) | |
tree | 2c708600f1cac4ba92be2eb201eabd01f089e8cf /gcc/ada/ali.adb | |
parent | fa7571cb7857050d2dbd9e1657baa6385b5f5475 (diff) | |
download | gcc-c2052d920b49395f766c1a47448d02f8896296e2.tar.gz |
2007-04-20 Vincent Celier <celier@adacore.com>
Robert Dewar <dewar@adacore.com>
* bcheck.adb, binde.adb, binderr.adb, binderr.ads, butil.adb,
butil.ads, erroutc.adb, erroutc.ads, errutil.adb, errutil.ads,
err_vars.ads, exp_tss.adb, exp_tss.ads, fmap.adb, fmap.ads,
fname.adb, fname.ads, fname-sf.adb, fname-uf.adb, fname-uf.ads,
lib-sort.adb, lib-util.adb, lib-util.ads, lib-xref.adb, makeutl.ads,
makeutl.adb, nmake.adt, osint.adb, osint.ads, osint-b.adb,
par-load.adb, prj-attr.adb, prj-dect.adb, prj-err.adb, prj-makr.adb,
prj-part.adb, prj-pp.adb, prj-proc.adb, prj-tree.adb, prj-tree.ads,
prj-util.adb, prj-util.ads, scans.adb, scans.ads, sem_ch2.adb,
sinput-c.adb, styleg-c.adb, tempdir.adb, tempdir.ads, uname.adb,
uname.ads, atree.h, atree.ads, atree.adb, ali-util.ads, ali-util.adb,
ali.ads, ali.adb:
Move Name_Id, File_Name_Type and Unit_Name_Type from package Types to
package Namet. Make File_Name_Type and Unit_Name_Type types derived from
Mame_Id. Add new type Path_Name_Type, also derived from Name_Id.
Use variables of types File_Name_Type and Unit_Name_Type in error
messages.
(Get_Name): Add parameter Ignore_Special, and set it reading file name
(New_Copy): When debugging the compiler, call New_Node_Debugging_Output
here.
Define flags Flag217-Flag230 with associated subprograms
(Flag_Word5): New record type.
(Flag_Word5_Ptr): New access type.
(To_Flag_Word5): New unchecked conversion.
(To_Flag_Word5_Ptr): Likewise.
(Flag216): New function.
(Set_Flag216): New procedure.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@125377 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/ali.adb')
-rw-r--r-- | gcc/ada/ali.adb | 149 |
1 files changed, 107 insertions, 42 deletions
diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index b987636ac7b..1b077c53bd3 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -27,7 +27,6 @@ with Butil; use Butil; with Debug; use Debug; with Fname; use Fname; -with Namet; use Namet; with Opt; use Opt; with Osint; use Osint; with Output; use Output; @@ -179,19 +178,37 @@ package body ALI is function Getc return Character; -- Get next character, bumping P past the character obtained + function Get_File_Name (Lower : Boolean := False) return File_Name_Type; + -- Skip blanks, then scan out a file name (name is left in Name_Buffer + -- with length in Name_Len, as well as returning a File_Name_Type value. + -- If lower is false, the case is unchanged, if Lower is True then the + -- result is forced to all lower case for systems where file names are + -- not case sensitive. This ensures that gnatbind works correctly + -- regardless of the case of the file name on all systems. The scan + -- is terminated by a end of line, space or horizontal tab. Any other + -- special characters are included in the returned name. + function Get_Name - (Lower : Boolean := False; - Ignore_Spaces : Boolean := False) return Name_Id; + (Ignore_Spaces : Boolean := False; + Ignore_Special : Boolean := False)return Name_Id; -- Skip blanks, then scan out a name (name is left in Name_Buffer with -- length in Name_Len, as well as being returned in Name_Id form). -- If Lower is set to True then the Name_Buffer will be converted to -- all lower case, for systems where file names are not case sensitive. -- This ensures that gnatbind works correctly regardless of the case - -- of the file name on all systems. The name is terminated by a either - -- white space (when Ignore_Spaces is False) or a typeref bracket or - -- an equal sign except for the special case of an operator name - -- starting with a double quite which is terminated by another double - -- quote. This function handles wide characters properly. + -- of the file name on all systems. The termination condition depends + -- on the settings of Ignore_Spaces and Ignore_Special: + -- + -- If Ignore_Spaces is False (normal case), then scan is terminated + -- by the normal end of field condition (EOL, space, horizontal tab) + -- + -- If Ignore_Special is False (normal case), the scan is terminated by + -- a typeref bracket or an equal sign except for the special case of + -- an operator name starting with a double quite which is terminated + -- by another double quote. + -- + -- It is an error to set both Ignore_Spaces and Ignore_Special to True. + -- This function handles wide characters properly. function Get_Nat return Nat; -- Skip blanks, then scan out an unsigned integer value in Nat range @@ -200,6 +217,11 @@ package body ALI is function Get_Stamp return Time_Stamp_Type; -- Skip blanks, then scan out a time stamp + function Get_Unit_Name return Unit_Name_Type; + -- Skip blanks, then scan out a file name (name is left in Name_Buffer + -- with length in Name_Len, as well as returning a Unit_Name_Type value. + -- The case is unchanged and terminated by a normal end of field. + function Nextc return Character; -- Return current character without modifying pointer P @@ -341,8 +363,14 @@ package body ALI is Write_Name (F); Write_Str (" is incorrectly formatted"); Write_Eol; - Write_Str - ("make sure you are using consistent versions of gcc/gnatbind"); + + Write_Str ("make sure you are using consistent versions " & + + -- Split the following line so that it can easily be transformed for + -- e.g. JVM/.NET back-ends where the compiler has a different name. + + "of gcc/gnatbind"); + Write_Eol; -- Find start of line @@ -409,13 +437,37 @@ package body ALI is end if; end Fatal_Error_Ignore; + ------------------- + -- Get_File_Name -- + ------------------- + + function Get_File_Name + (Lower : Boolean := False) return File_Name_Type + is + F : Name_Id; + + begin + F := Get_Name (Ignore_Special => True); + + -- Convert file name to all lower case if file names are not case + -- sensitive. This ensures that we handle names in the canonical + -- lower case format, regardless of the actual case. + + if Lower and not File_Names_Case_Sensitive then + Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); + return Name_Find; + else + return File_Name_Type (F); + end if; + end Get_File_Name; + -------------- -- Get_Name -- -------------- function Get_Name - (Lower : Boolean := False; - Ignore_Spaces : Boolean := False) return Name_Id + (Ignore_Spaces : Boolean := False; + Ignore_Special : Boolean := False) return Name_Id is begin Name_Len := 0; @@ -435,39 +487,42 @@ package body ALI is exit when At_End_Of_Field and not Ignore_Spaces; - if Name_Buffer (1) = '"' then - exit when Name_Len > 1 and then Name_Buffer (Name_Len) = '"'; + if not Ignore_Special then + if Name_Buffer (1) = '"' then + exit when Name_Len > 1 and then Name_Buffer (Name_Len) = '"'; - else - -- Terminate on parens or angle brackets or equal sign + else + -- Terminate on parens or angle brackets or equal sign - exit when Nextc = '(' or else Nextc = ')' - or else Nextc = '{' or else Nextc = '}' - or else Nextc = '<' or else Nextc = '>' - or else Nextc = '='; + exit when Nextc = '(' or else Nextc = ')' + or else Nextc = '{' or else Nextc = '}' + or else Nextc = '<' or else Nextc = '>' + or else Nextc = '='; - -- Terminate if left bracket not part of wide char sequence - -- Note that we only recognize brackets notation so far ??? + -- Terminate if left bracket not part of wide char sequence + -- Note that we only recognize brackets notation so far ??? - exit when Nextc = '[' and then T (P + 1) /= '"'; + exit when Nextc = '[' and then T (P + 1) /= '"'; - -- Terminate if right bracket not part of wide char sequence + -- Terminate if right bracket not part of wide char sequence - exit when Nextc = ']' and then T (P - 1) /= '"'; + exit when Nextc = ']' and then T (P - 1) /= '"'; + end if; end if; end loop; - -- Convert file name to all lower case if file names are not case - -- sensitive. This ensures that we handle names in the canonical - -- lower case format, regardless of the actual case. - - if Lower and not File_Names_Case_Sensitive then - Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); - end if; - return Name_Find; end Get_Name; + ------------------- + -- Get_Unit_Name -- + ------------------- + + function Get_Unit_Name return Unit_Name_Type is + begin + return Unit_Name_Type (Get_Name); + end Get_Unit_Name; + ------------- -- Get_Nat -- ------------- @@ -767,7 +822,7 @@ package body ALI is Queuing_Policy => ' ', Restrictions => No_Restrictions, SAL_Interface => False, - Sfile => No_Name, + Sfile => No_File, Task_Dispatching_Policy => ' ', Time_Slice_Value => -1, WC_Encoding => '8', @@ -1328,11 +1383,11 @@ package body ALI is UL : Unit_Record renames Units.Table (Units.Last); begin - UL.Uname := Get_Name; + UL.Uname := Get_Unit_Name; UL.Predefined := Is_Predefined_Unit; UL.Internal := Is_Internal_Unit; UL.My_ALI := Id; - UL.Sfile := Get_Name (Lower => True); + UL.Sfile := Get_File_Name (Lower => True); UL.Pure := False; UL.Preelab := False; UL.No_Elab := False; @@ -1617,7 +1672,7 @@ package body ALI is Checkc (' '); Skip_Space; Withs.Increment_Last; - Withs.Table (Withs.Last).Uname := Get_Name; + Withs.Table (Withs.Last).Uname := Get_Unit_Name; Withs.Table (Withs.Last).Elaborate := False; Withs.Table (Withs.Last).Elaborate_All := False; Withs.Table (Withs.Last).Elab_Desirable := False; @@ -1633,8 +1688,10 @@ package body ALI is -- Normal case else - Withs.Table (Withs.Last).Sfile := Get_Name (Lower => True); - Withs.Table (Withs.Last).Afile := Get_Name; + Withs.Table (Withs.Last).Sfile := Get_File_Name + (Lower => True); + Withs.Table (Withs.Last).Afile := Get_File_Name + (Lower => True); -- Scan out possible E, EA, ED, and AD parameters @@ -1675,6 +1732,9 @@ package body ALI is True; end if; end if; + + else + Fatal_Error; end if; end loop; end if; @@ -1852,7 +1912,12 @@ package body ALI is Checkc (' '); Skip_Space; Sdep.Increment_Last; - Sdep.Table (Sdep.Last).Sfile := Get_Name (Lower => True); + + -- In the following call, Lower is not set to True, this is either + -- a bug, or it deserves a special comment as to why this is so??? + + Sdep.Table (Sdep.Last).Sfile := Get_File_Name; + Sdep.Table (Sdep.Last).Stamp := Get_Stamp; Sdep.Table (Sdep.Last).Dummy_Entry := (Sdep.Table (Sdep.Last).Stamp = Dummy_Time_Stamp); @@ -1982,7 +2047,7 @@ package body ALI is begin XS.File_Num := Sdep_Id (Get_Nat + Nat (First_Sdep_Entry) - 1); - XS.File_Name := Get_Name; + XS.File_Name := Get_File_Name; XS.First_Entity := Xref_Entity.Last + 1; Current_File_Num := XS.File_Num; |