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 | |
| 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')
58 files changed, 1293 insertions, 781 deletions
diff --git a/gcc/ada/ali-util.adb b/gcc/ada/ali-util.adb index 2ed90a70e18..f908cfa002a 100644 --- a/gcc/ada/ali-util.adb +++ b/gcc/ada/ali-util.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 Debug; use Debug; with Binderr; use Binderr; with Lib; use Lib; -with Namet; use Namet; with Opt; use Opt; with Output; use Output; with Osint; use Osint; @@ -134,8 +133,8 @@ package body ALI.Util is -- Get_File_Checksum -- ----------------------- - function Get_File_Checksum (Fname : Name_Id) return Word is - Full_Name : Name_Id; + function Get_File_Checksum (Fname : File_Name_Type) return Word is + Full_Name : File_Name_Type; Source_Index : Source_File_Index; begin @@ -255,9 +254,9 @@ package body ALI.Util is if Text = null then if Generic_Separately_Compiled (Withs.Table (W).Sfile) then - Error_Msg_Name_1 := Afile; - Error_Msg_Name_2 := Withs.Table (W).Sfile; - Error_Msg ("% not found, % must be compiled"); + Error_Msg_File_1 := Afile; + Error_Msg_File_2 := Withs.Table (W).Sfile; + Error_Msg ("{ not found, { must be compiled"); Set_Name_Table_Info (Afile, Int (No_Unit_Id)); return; @@ -278,13 +277,13 @@ package body ALI.Util is Free (Text); if ALIs.Table (Idread).Compile_Errors then - Error_Msg_Name_1 := Withs.Table (W).Sfile; - Error_Msg ("% had errors, must be fixed, and recompiled"); + Error_Msg_File_1 := Withs.Table (W).Sfile; + Error_Msg ("{ had errors, must be fixed, and recompiled"); Set_Name_Table_Info (Afile, Int (No_Unit_Id)); elsif ALIs.Table (Idread).No_Object then - Error_Msg_Name_1 := Withs.Table (W).Sfile; - Error_Msg ("% must be recompiled"); + Error_Msg_File_1 := Withs.Table (W).Sfile; + Error_Msg ("{ must be recompiled"); Set_Name_Table_Info (Afile, Int (No_Unit_Id)); end if; @@ -335,7 +334,7 @@ package body ALI.Util is loop F := Sdep.Table (D).Sfile; - if F /= No_Name then + if F /= No_File then -- If this is the first time we are seeing this source file, -- then make a new entry in the source table. @@ -376,8 +375,8 @@ package body ALI.Util is -- In All_Sources mode, flag error of file not found if Opt.All_Sources then - Error_Msg_Name_1 := F; - Error_Msg ("cannot locate %"); + Error_Msg_File_1 := F; + Error_Msg ("cannot locate {"); end if; end if; @@ -468,8 +467,7 @@ package body ALI.Util is function Time_Stamp_Mismatch (A : ALI_Id; - Read_Only : Boolean := False) - return File_Name_Type + Read_Only : Boolean := False) return File_Name_Type is Src : Source_Id; -- Source file Id for the current Sdep entry diff --git a/gcc/ada/ali-util.ads b/gcc/ada/ali-util.ads index ff919f723c4..9a6e8dc4ba0 100644 --- a/gcc/ada/ali-util.ads +++ b/gcc/ada/ali-util.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2003 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- -- @@ -109,15 +109,14 @@ package ALI.Util is -- be read, scanned, and processed recursively. procedure Set_Source_Table (A : ALI_Id); - -- Build source table entry corresponding to the ALI file whose id is A. + -- Build source table entry corresponding to the ALI file whose id is A procedure Set_Source_Table; - -- Build the entire source table. + -- Build the entire source table function Time_Stamp_Mismatch (A : ALI_Id; - Read_Only : Boolean := False) - return File_Name_Type; + Read_Only : Boolean := False) return File_Name_Type; -- Looks in the Source_Table and checks time stamp mismatches between -- the sources there and the sources in the Sdep section of ali file whose -- id is A. If no time stamp mismatches are found No_File is returned. @@ -139,7 +138,7 @@ package ALI.Util is -- in a false negative, but that is never harmful, it just means -- that in unusual cases an unnecessary recompilation occurs. - function Get_File_Checksum (Fname : Name_Id) return Word; + function Get_File_Checksum (Fname : File_Name_Type) return Word; -- Compute checksum for the given file. As far as possible, this circuit -- computes exactly the same value computed by the compiler, but it does -- not matter if it gets it wrong in marginal cases, since the only result 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; diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads index 5a4dcaae38a..12bb7325804 100644 --- a/gcc/ada/ali.ads +++ b/gcc/ada/ali.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- 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- -- @@ -30,6 +30,7 @@ with Casing; use Casing; with Gnatvsn; use Gnatvsn; +with Namet; use Namet; with Rident; use Rident; with Table; with Types; use Types; @@ -90,7 +91,7 @@ package ALI is Afile : File_Name_Type; -- Name of ALI file - Ofile_Full_Name : Name_Id; + Ofile_Full_Name : File_Name_Type; -- Full name of object file corresponding to the ALI file Sfile : File_Name_Type; @@ -741,7 +742,7 @@ package ALI is File_Num : Sdep_Id; -- Dependency number for file (entry in Sdep.Table) - File_Name : Name_Id; + File_Name : File_Name_Type; -- Name of file First_Entity : Nat; diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index e079c69b98a..aad0b949aaf 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.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- -- @@ -39,7 +39,6 @@ pragma Style_Checks (All_Checks); -- file containing equivalent definitions for use by gigi. with Debug; use Debug; -with Namet; use Namet; with Nlists; use Nlists; with Elists; use Elists; with Output; use Output; @@ -345,6 +344,62 @@ package body Atree is function To_Flag_Word4_Ptr is new Unchecked_Conversion (Union_Id_Ptr, Flag_Word4_Ptr); + -- The following declarations are used to store flags 216-247 in the + -- Field12 field of the fifth component of an extended (entity) node. + + type Flag_Word5 is record + Flag216 : Boolean; + Flag217 : Boolean; + Flag218 : Boolean; + Flag219 : Boolean; + Flag220 : Boolean; + Flag221 : Boolean; + Flag222 : Boolean; + Flag223 : Boolean; + + Flag224 : Boolean; + Flag225 : Boolean; + Flag226 : Boolean; + Flag227 : Boolean; + Flag228 : Boolean; + Flag229 : Boolean; + Flag230 : Boolean; + + -- Note: flags 231-247 not in use yet + + Flag231 : Boolean; + + Flag232 : Boolean; + Flag233 : Boolean; + Flag234 : Boolean; + Flag235 : Boolean; + Flag236 : Boolean; + Flag237 : Boolean; + Flag238 : Boolean; + Flag239 : Boolean; + + Flag240 : Boolean; + Flag241 : Boolean; + Flag242 : Boolean; + Flag243 : Boolean; + Flag244 : Boolean; + Flag245 : Boolean; + Flag246 : Boolean; + Flag247 : Boolean; + end record; + + pragma Pack (Flag_Word5); + for Flag_Word5'Size use 32; + for Flag_Word5'Alignment use 4; + + type Flag_Word5_Ptr is access all Flag_Word5; + + function To_Flag_Word5 is new + Unchecked_Conversion (Union_Id, Flag_Word5); + + function To_Flag_Word5_Ptr is new + Unchecked_Conversion (Union_Id_Ptr, Flag_Word5_Ptr); + -- Default value used to initialize default nodes. Note that some of the -- fields get overwritten, and in particular, Nkind always gets reset. @@ -445,7 +500,7 @@ package body Atree is package Orig_Nodes is new Table.Table ( Table_Component_Type => Node_Id, - Table_Index_Type => Node_Id, + Table_Index_Type => Node_Id'Base, Table_Low_Bound => First_Node_Id, Table_Initial => Alloc.Orig_Nodes_Initial, Table_Increment => Alloc.Orig_Nodes_Increment, @@ -1124,6 +1179,7 @@ package body Atree is -- the copy, since we inserted the original, not the copy. Nodes.Table (New_Id).Rewrite_Ins := False; + pragma Debug (New_Node_Debugging_Output (New_Id)); end if; return New_Id; @@ -2092,9 +2148,9 @@ package body Atree is Nodes.Table (Nod).Sloc := New_Sloc; pragma Debug (New_Node_Debugging_Output (Nod)); - -- If this is a node with a real location and we are generating - -- source nodes, then reset Current_Error_Node. This is useful - -- if we bomb during parsing to get a error location for the bomb. + -- If this is a node with a real location and we are generating source + -- nodes, then reset Current_Error_Node. This is useful if we bomb + -- during parsing to get an error location for the bomb. if Default_Node.Comes_From_Source and then New_Sloc > No_Location then Current_Error_Node := Nod; @@ -4619,6 +4675,96 @@ package body Atree is return To_Flag_Word4 (Nodes.Table (N + 4).Field11).Flag215; end Flag215; + function Flag216 (N : Node_Id) return Boolean is + begin + pragma Assert (Nkind (N) in N_Entity); + return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag216; + end Flag216; + + function Flag217 (N : Node_Id) return Boolean is + begin + pragma Assert (Nkind (N) in N_Entity); + return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag217; + end Flag217; + + function Flag218 (N : Node_Id) return Boolean is + begin + pragma Assert (Nkind (N) in N_Entity); + return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag218; + end Flag218; + + function Flag219 (N : Node_Id) return Boolean is + begin + pragma Assert (Nkind (N) in N_Entity); + return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag219; + end Flag219; + + function Flag220 (N : Node_Id) return Boolean is + begin + pragma Assert (Nkind (N) in N_Entity); + return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag220; + end Flag220; + + function Flag221 (N : Node_Id) return Boolean is + begin + pragma Assert (Nkind (N) in N_Entity); + return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag221; + end Flag221; + + function Flag222 (N : Node_Id) return Boolean is + begin + pragma Assert (Nkind (N) in N_Entity); + return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag222; + end Flag222; + + function Flag223 (N : Node_Id) return Boolean is + begin + pragma Assert (Nkind (N) in N_Entity); + return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag223; + end Flag223; + + function Flag224 (N : Node_Id) return Boolean is + begin + pragma Assert (Nkind (N) in N_Entity); + return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag224; + end Flag224; + + function Flag225 (N : Node_Id) return Boolean is + begin + pragma Assert (Nkind (N) in N_Entity); + return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag225; + end Flag225; + + function Flag226 (N : Node_Id) return Boolean is + begin + pragma Assert (Nkind (N) in N_Entity); + return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag226; + end Flag226; + + function Flag227 (N : Node_Id) return Boolean is + begin + pragma Assert (Nkind (N) in N_Entity); + return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag227; + end Flag227; + + function Flag228 (N : Node_Id) return Boolean is + begin + pragma Assert (Nkind (N) in N_Entity); + return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag228; + end Flag228; + + function Flag229 (N : Node_Id) return Boolean is + begin + pragma Assert (Nkind (N) in N_Entity); + return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag229; + end Flag229; + + function Flag230 (N : Node_Id) return Boolean is + begin + pragma Assert (Nkind (N) in N_Entity); + return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag230; + end Flag230; + procedure Set_Nkind (N : Node_Id; Val : Node_Kind) is begin pragma Assert (N in Nodes.First .. Nodes.Last); @@ -6725,6 +6871,126 @@ package body Atree is (Nodes.Table (N + 4).Field11'Unrestricted_Access)).Flag215 := Val; end Set_Flag215; + procedure Set_Flag216 (N : Node_Id; Val : Boolean) is + begin + pragma Assert (Nkind (N) in N_Entity); + To_Flag_Word5_Ptr + (Union_Id_Ptr' + (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag216 := Val; + end Set_Flag216; + + procedure Set_Flag217 (N : Node_Id; Val : Boolean) is + begin + pragma Assert (Nkind (N) in N_Entity); + To_Flag_Word5_Ptr + (Union_Id_Ptr' + (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag217 := Val; + end Set_Flag217; + + procedure Set_Flag218 (N : Node_Id; Val : Boolean) is + begin + pragma Assert (Nkind (N) in N_Entity); + To_Flag_Word5_Ptr + (Union_Id_Ptr' + (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag218 := Val; + end Set_Flag218; + + procedure Set_Flag219 (N : Node_Id; Val : Boolean) is + begin + pragma Assert (Nkind (N) in N_Entity); + To_Flag_Word5_Ptr + (Union_Id_Ptr' + (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag219 := Val; + end Set_Flag219; + + procedure Set_Flag220 (N : Node_Id; Val : Boolean) is + begin + pragma Assert (Nkind (N) in N_Entity); + To_Flag_Word5_Ptr + (Union_Id_Ptr' + (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag220 := Val; + end Set_Flag220; + + procedure Set_Flag221 (N : Node_Id; Val : Boolean) is + begin + pragma Assert (Nkind (N) in N_Entity); + To_Flag_Word5_Ptr + (Union_Id_Ptr' + (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag221 := Val; + end Set_Flag221; + + procedure Set_Flag222 (N : Node_Id; Val : Boolean) is + begin + pragma Assert (Nkind (N) in N_Entity); + To_Flag_Word5_Ptr + (Union_Id_Ptr' + (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag222 := Val; + end Set_Flag222; + + procedure Set_Flag223 (N : Node_Id; Val : Boolean) is + begin + pragma Assert (Nkind (N) in N_Entity); + To_Flag_Word5_Ptr + (Union_Id_Ptr' + (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag223 := Val; + end Set_Flag223; + + procedure Set_Flag224 (N : Node_Id; Val : Boolean) is + begin + pragma Assert (Nkind (N) in N_Entity); + To_Flag_Word5_Ptr + (Union_Id_Ptr' + (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag224 := Val; + end Set_Flag224; + + procedure Set_Flag225 (N : Node_Id; Val : Boolean) is + begin + pragma Assert (Nkind (N) in N_Entity); + To_Flag_Word5_Ptr + (Union_Id_Ptr' + (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag225 := Val; + end Set_Flag225; + + procedure Set_Flag226 (N : Node_Id; Val : Boolean) is + begin + pragma Assert (Nkind (N) in N_Entity); + To_Flag_Word5_Ptr + (Union_Id_Ptr' + (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag226 := Val; + end Set_Flag226; + + procedure Set_Flag227 (N : Node_Id; Val : Boolean) is + begin + pragma Assert (Nkind (N) in N_Entity); + To_Flag_Word5_Ptr + (Union_Id_Ptr' + (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag227 := Val; + end Set_Flag227; + + procedure Set_Flag228 (N : Node_Id; Val : Boolean) is + begin + pragma Assert (Nkind (N) in N_Entity); + To_Flag_Word5_Ptr + (Union_Id_Ptr' + (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag228 := Val; + end Set_Flag228; + + procedure Set_Flag229 (N : Node_Id; Val : Boolean) is + begin + pragma Assert (Nkind (N) in N_Entity); + To_Flag_Word5_Ptr + (Union_Id_Ptr' + (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag229 := Val; + end Set_Flag229; + + procedure Set_Flag230 (N : Node_Id; Val : Boolean) is + begin + pragma Assert (Nkind (N) in N_Entity); + To_Flag_Word5_Ptr + (Union_Id_Ptr' + (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag230 := Val; + end Set_Flag230; + procedure Set_Node1_With_Parent (N : Node_Id; Val : Node_Id) is begin pragma Assert (N in Nodes.First .. Nodes.Last); @@ -6807,4 +7073,14 @@ package body Atree is end Unchecked_Access; + ------------ + -- Unlock -- + ------------ + + procedure Unlock is + begin + Nodes.Locked := False; + Orig_Nodes.Locked := False; + end Unlock; + end Atree; diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index 3d1192bff3f..2902aea7f38 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- 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- -- @@ -34,6 +34,7 @@ with Alloc; with Sinfo; use Sinfo; with Einfo; use Einfo; +with Namet; use Namet; with Types; use Types; with Snames; use Snames; with System; use System; @@ -59,7 +60,7 @@ package Atree is -- by the parser. The package Entity_Info defines the semantic information -- which is added to the tree nodes that represent declared entities (i.e. -- the information which might typically be described in a separate symbol --- table structure. +-- table structure). -- The front end of the compiler first parses the program and generates a -- tree that is simply a syntactic representation of the program in abstract @@ -84,7 +85,7 @@ package Atree is -- show which token is referenced by this pointer. -- In_List A flag used to indicate if the node is a member - -- of a node list. + -- of a node list. -- Rewrite_Sub A flag set if the node has been rewritten using -- the Rewrite procedure. The original value of the @@ -97,7 +98,7 @@ package Atree is -- the level of parentheses. Up to 3 levels can be -- accomodated. Anything more than 3 levels is treated -- as 3 levels (conformance tests that complain about - -- this are hereby deemed pathological!) Set to zero + -- this are hereby deemed pathological!). Set to zero -- for non-subexpression nodes. -- Comes_From_Source @@ -144,7 +145,7 @@ package Atree is -- it will take a bit of fiddling to change that ??? -- Note: the actual usage of FieldN (i.e. whether it contains a Elist_Id, - -- List_Id, Name_Id, Node_Id, String_Id, Uint or Ureal), depends on the + -- List_Id, Name_Id, Node_Id, String_Id, Uint or Ureal) depends on the -- value in Nkind. Generally the access to this field is always via the -- functional interface, so the field names ElistN, ListN, NameN, NodeN, -- StrN, UintN and UrealN are used only in the bodies of the access @@ -186,9 +187,9 @@ package Atree is -- entity, it is of type Entity_Kind which is defined -- in package Einfo. - -- Flag19 197 additional flags + -- Flag19 229 additional flags -- ... - -- Flag215 + -- Flag247 -- Convention Entity convention (Convention_Id value) @@ -302,7 +303,7 @@ package Atree is ------------------------------------- -- A subpackage Atree.Unchecked_Access provides routines for reading and - -- writing the fields defined above (Field1-27, Node1-27, Flag1-215 etc). + -- writing the fields defined above (Field1-27, Node1-27, Flag1-247 etc). -- These unchecked access routines can be used for untyped traversals. -- In addition they are used in the implementations of the Sinfo and -- Einfo packages. These packages both provide logical synonyms for @@ -321,7 +322,7 @@ package Atree is -- which the parser could not parse correctly, and adding additional -- semantic information (e.g. making constraint checks explicit). The -- following subprograms are used for constructing the tree in the first - -- place, and then for subsequent modifications as required + -- place, and then for subsequent modifications as required. procedure Initialize; -- Called at the start of compilation to initialize the allocation of @@ -330,7 +331,11 @@ package Atree is -- Tree_Read is used. procedure Lock; - -- Called before the backend is invoked to lock the nodes table + -- Called before the back end is invoked to lock the nodes table + -- Also called after Unlock to relock??? + + procedure Unlock; + -- Unlocks nodes table, in cases where the back end needs to modify it procedure Tree_Read; -- Initializes internal tables from current tree file using the relevant @@ -1708,6 +1713,51 @@ package Atree is function Flag215 (N : Node_Id) return Boolean; pragma Inline (Flag215); + function Flag216 (N : Node_Id) return Boolean; + pragma Inline (Flag216); + + function Flag217 (N : Node_Id) return Boolean; + pragma Inline (Flag217); + + function Flag218 (N : Node_Id) return Boolean; + pragma Inline (Flag218); + + function Flag219 (N : Node_Id) return Boolean; + pragma Inline (Flag219); + + function Flag220 (N : Node_Id) return Boolean; + pragma Inline (Flag220); + + function Flag221 (N : Node_Id) return Boolean; + pragma Inline (Flag221); + + function Flag222 (N : Node_Id) return Boolean; + pragma Inline (Flag222); + + function Flag223 (N : Node_Id) return Boolean; + pragma Inline (Flag223); + + function Flag224 (N : Node_Id) return Boolean; + pragma Inline (Flag224); + + function Flag225 (N : Node_Id) return Boolean; + pragma Inline (Flag225); + + function Flag226 (N : Node_Id) return Boolean; + pragma Inline (Flag226); + + function Flag227 (N : Node_Id) return Boolean; + pragma Inline (Flag227); + + function Flag228 (N : Node_Id) return Boolean; + pragma Inline (Flag228); + + function Flag229 (N : Node_Id) return Boolean; + pragma Inline (Flag229); + + function Flag230 (N : Node_Id) return Boolean; + pragma Inline (Flag230); + -- Procedures to set value of indicated field procedure Set_Nkind (N : Node_Id; Val : Node_Kind); @@ -2637,6 +2687,51 @@ package Atree is procedure Set_Flag215 (N : Node_Id; Val : Boolean); pragma Inline (Set_Flag215); + procedure Set_Flag216 (N : Node_Id; Val : Boolean); + pragma Inline (Set_Flag216); + + procedure Set_Flag217 (N : Node_Id; Val : Boolean); + pragma Inline (Set_Flag217); + + procedure Set_Flag218 (N : Node_Id; Val : Boolean); + pragma Inline (Set_Flag218); + + procedure Set_Flag219 (N : Node_Id; Val : Boolean); + pragma Inline (Set_Flag219); + + procedure Set_Flag220 (N : Node_Id; Val : Boolean); + pragma Inline (Set_Flag220); + + procedure Set_Flag221 (N : Node_Id; Val : Boolean); + pragma Inline (Set_Flag221); + + procedure Set_Flag222 (N : Node_Id; Val : Boolean); + pragma Inline (Set_Flag222); + + procedure Set_Flag223 (N : Node_Id; Val : Boolean); + pragma Inline (Set_Flag223); + + procedure Set_Flag224 (N : Node_Id; Val : Boolean); + pragma Inline (Set_Flag224); + + procedure Set_Flag225 (N : Node_Id; Val : Boolean); + pragma Inline (Set_Flag225); + + procedure Set_Flag226 (N : Node_Id; Val : Boolean); + pragma Inline (Set_Flag226); + + procedure Set_Flag227 (N : Node_Id; Val : Boolean); + pragma Inline (Set_Flag227); + + procedure Set_Flag228 (N : Node_Id; Val : Boolean); + pragma Inline (Set_Flag228); + + procedure Set_Flag229 (N : Node_Id; Val : Boolean); + pragma Inline (Set_Flag229); + + procedure Set_Flag230 (N : Node_Id; Val : Boolean); + pragma Inline (Set_Flag230); + -- The following versions of Set_Noden also set the parent -- pointer of the referenced node if it is non_Empty @@ -2693,12 +2788,12 @@ package Atree is ------------------------- -- The nodes of the tree are stored in a table (i.e. an array). In the - -- case of extended nodes four consecutive components in the array are + -- case of extended nodes five consecutive components in the array are -- used. There are thus two formats for array components. One is used -- for non-extended nodes, and for the first component of extended - -- nodes. The other is used for the extension parts (second, third and - -- fourth components) of an extended node. A variant record structure - -- is used to distinguish the two formats. + -- nodes. The other is used for the extension parts (second, third, + -- fourth and fifth components) of an extended node. A variant record + -- structure is used to distinguish the two formats. type Node_Record (Is_Extension : Boolean := False) is record @@ -2820,6 +2915,7 @@ package Atree is -- Extension (second component) of extended node when True => + Field6 : Union_Id; Field7 : Union_Id; Field8 : Union_Id; @@ -2852,7 +2948,7 @@ package Atree is -- Field6-10 Holds Field24-Field28 -- Field11 Holds Flag184-Flag215 - -- Field12 currently unused, reserved for expansion + -- Field12 Holds Flag216-Flag230 end case; end record; @@ -2861,12 +2957,12 @@ package Atree is for Node_Record'Size use 8*32; for Node_Record'Alignment use 4; - -- The following defines the extendible array used for the nodes table - -- Nodes with extensions use two consecutive entries in the array + -- The following defines the extendable array used for the nodes table + -- Nodes with extensions use five consecutive entries in the array package Nodes is new Table.Table ( Table_Component_Type => Node_Record, - Table_Index_Type => Node_Id, + Table_Index_Type => Node_Id'Base, Table_Low_Bound => First_Node_Id, Table_Initial => Alloc.Nodes_Initial, Table_Increment => Alloc.Nodes_Increment, diff --git a/gcc/ada/atree.h b/gcc/ada/atree.h index 5e8a1a7e885..1137465282e 100644 --- a/gcc/ada/atree.h +++ b/gcc/ada/atree.h @@ -6,7 +6,7 @@ * * * C Header File * * * - * 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- * @@ -256,6 +256,46 @@ struct Flag_Word4 Boolean flag215 : 1; }; +/* Structure used for extra flags in fifth component overlaying Field12 */ +struct Flag_Word5 +{ + Boolean flag216 : 1; + Boolean flag217 : 1; + Boolean flag218 : 1; + Boolean flag219 : 1; + Boolean flag220 : 1; + Boolean flag221 : 1; + Boolean flag222 : 1; + Boolean flag223 : 1; + + Boolean flag224 : 1; + Boolean flag225 : 1; + Boolean flag226 : 1; + Boolean flag227 : 1; + Boolean flag228 : 1; + Boolean flag229 : 1; + Boolean flag230 : 1; + Boolean flag231 : 1; + + Boolean flag232 : 1; + Boolean flag233 : 1; + Boolean flag234 : 1; + Boolean flag235 : 1; + Boolean flag236 : 1; + Boolean flag237 : 1; + Boolean flag238 : 1; + Boolean flag239 : 1; + + Boolean flag240 : 1; + Boolean flag241 : 1; + Boolean flag242 : 1; + Boolean flag243 : 1; + Boolean flag244 : 1; + Boolean flag245 : 1; + Boolean flag246 : 1; + Boolean flag247 : 1; +}; + struct Non_Extended { Source_Ptr sloc; @@ -287,6 +327,7 @@ struct Extended Int field12; struct Flag_Word fw; struct Flag_Word2 fw2; + struct Flag_Word5 fw5; } U; }; @@ -686,3 +727,18 @@ extern Node_Id Current_Error_Node; #define Flag213(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag213) #define Flag214(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag214) #define Flag215(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.fw4.flag215) +#define Flag216(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag216) +#define Flag217(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag217) +#define Flag218(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag218) +#define Flag219(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag219) +#define Flag220(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag220) +#define Flag221(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag221) +#define Flag222(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag222) +#define Flag223(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag223) +#define Flag224(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag224) +#define Flag225(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag225) +#define Flag226(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag226) +#define Flag227(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag227) +#define Flag228(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag228) +#define Flag229(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag229) +#define Flag230(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw5.flag230) diff --git a/gcc/ada/bcheck.adb b/gcc/ada/bcheck.adb index a57856e48e5..15b6b1ebb0e 100644 --- a/gcc/ada/bcheck.adb +++ b/gcc/ada/bcheck.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- -- @@ -60,7 +60,7 @@ package body Bcheck is -- Produce an error or a warning message, depending on whether an -- inconsistent configuration is permitted or not. - function Same_Unit (U1 : Name_Id; U2 : Name_Id) return Boolean; + function Same_Unit (U1 : Unit_Name_Type; U2 : Name_Id) return Boolean; -- Used to compare two unit names for No_Dependence checks. U1 is in -- standard unit name format, and U2 is in literal form with periods. @@ -102,7 +102,7 @@ package body Bcheck is Src : Source_Id; -- Source file Id for this Sdep entry - ALI_Path_Id : Name_Id; + ALI_Path_Id : File_Name_Type; begin -- First, we go through the source table to see if there are any cases @@ -171,19 +171,19 @@ package body Bcheck is if Sdep.Table (D).Stamp /= Source.Table (Src).Stamp and then not Source.Table (Src).All_Checksums_Match then - Error_Msg_Name_1 := ALIs.Table (A).Sfile; - Error_Msg_Name_2 := Sdep.Table (D).Sfile; + Error_Msg_File_1 := ALIs.Table (A).Sfile; + Error_Msg_File_2 := Sdep.Table (D).Sfile; -- Two styles of message, depending on whether or not -- the updated file is the one that must be recompiled - if Error_Msg_Name_1 = Error_Msg_Name_2 then + if Error_Msg_File_1 = Error_Msg_File_2 then if Tolerate_Consistency_Errors then Error_Msg - ("?% has been modified and should be recompiled"); + ("?{ has been modified and should be recompiled"); else Error_Msg - ("% has been modified and must be recompiled"); + ("{ has been modified and must be recompiled"); end if; else @@ -191,14 +191,13 @@ package body Bcheck is Osint.Find_File ((ALIs.Table (A).Afile), Osint.Library); if Osint.Is_Readonly_Library (ALI_Path_Id) then if Tolerate_Consistency_Errors then - Error_Msg ("?% should be recompiled"); - Error_Msg_Name_1 := ALI_Path_Id; - Error_Msg ("?(% is obsolete and read-only)"); - + Error_Msg ("?{ should be recompiled"); + Error_Msg_File_1 := ALI_Path_Id; + Error_Msg ("?({ is obsolete and read-only)"); else - Error_Msg ("% must be compiled"); - Error_Msg_Name_1 := ALI_Path_Id; - Error_Msg ("(% is obsolete and read-only)"); + Error_Msg ("{ must be compiled"); + Error_Msg_File_1 := ALI_Path_Id; + Error_Msg ("({ is obsolete and read-only)"); end if; elsif Tolerate_Consistency_Errors then @@ -206,34 +205,21 @@ package body Bcheck is ("?% should be recompiled (% has been modified)"); else - Error_Msg ("% must be recompiled (% has been modified)"); + Error_Msg ("{ must be recompiled ({ has been modified)"); end if; end if; if (not Tolerate_Consistency_Errors) and Verbose_Mode then - declare - Msg : constant String := "% time stamp "; - Buf : String (1 .. Msg'Length + Time_Stamp_Length); - - begin - Buf (1 .. Msg'Length) := Msg; - Buf (Msg'Length + 1 .. Buf'Length) := - String (Source.Table (Src).Stamp); - Error_Msg_Name_1 := Sdep.Table (D).Sfile; - Error_Msg (Buf); - end; + Error_Msg_File_1 := Sdep.Table (D).Sfile; + Error_Msg + ("{ time stamp " & String (Source.Table (Src).Stamp)); - declare - Msg : constant String := " conflicts with % timestamp "; - Buf : String (1 .. Msg'Length + Time_Stamp_Length); + Error_Msg_File_1 := Sdep.Table (D).Sfile; + -- Something wrong here, should be different file ??? - begin - Buf (1 .. Msg'Length) := Msg; - Buf (Msg'Length + 1 .. Buf'Length) := - String (Sdep.Table (D).Stamp); - Error_Msg_Name_1 := Sdep.Table (D).Sfile; - Error_Msg (Buf); - end; + Error_Msg + (" conflicts with { timestamp " & + String (Sdep.Table (D).Stamp)); end if; -- Exit from the loop through Sdep entries once we find one @@ -299,11 +285,11 @@ package body Bcheck is and then ALIs.Table (A2).Task_Dispatching_Policy /= Policy then - Error_Msg_Name_1 := ALIs.Table (A1).Sfile; - Error_Msg_Name_2 := ALIs.Table (A2).Sfile; + Error_Msg_File_1 := ALIs.Table (A1).Sfile; + Error_Msg_File_2 := ALIs.Table (A2).Sfile; Consistency_Error_Msg - ("% and % compiled with different task" & + ("{ and { compiled with different task" & " dispatching policies"); exit Find_Policy; end if; @@ -370,15 +356,15 @@ package body Bcheck is -- same partition. if Task_Dispatching_Policy_Specified /= ' ' then - Error_Msg_Name_1 := ALIs.Table (F).Sfile; - Error_Msg_Name_2 := + Error_Msg_File_1 := ALIs.Table (F).Sfile; + Error_Msg_File_2 := ALIs.Table (TDP_Pragma_Afile).Sfile; - Error_Msg_Nat_1 := DTK.PSD_Pragma_Line; + Error_Msg_Nat_1 := DTK.PSD_Pragma_Line; Consistency_Error_Msg - ("Priority_Specific_Dispatching at %:#" & - " incompatible with Task_Dispatching_Policy at %"); + ("Priority_Specific_Dispatching at {:#" & + " incompatible with Task_Dispatching_Policy at {"); end if; -- Ceiling_Locking must also be specified for a partition @@ -392,14 +378,14 @@ package body Bcheck is if ALIs.Table (A).Locking_Policy /= ' ' and then ALIs.Table (A).Locking_Policy /= 'C' then - Error_Msg_Name_1 := ALIs.Table (F).Sfile; - Error_Msg_Name_2 := ALIs.Table (A).Sfile; + Error_Msg_File_1 := ALIs.Table (F).Sfile; + Error_Msg_File_2 := ALIs.Table (A).Sfile; Error_Msg_Nat_1 := DTK.PSD_Pragma_Line; Consistency_Error_Msg - ("Priority_Specific_Dispatching at %:#" & - " incompatible with Locking_Policy at %"); + ("Priority_Specific_Dispatching at {:#" & + " incompatible with Locking_Policy at {"); end if; end loop; end if; @@ -418,14 +404,14 @@ package body Bcheck is DTK.Dispatching_Policy then - Error_Msg_Name_1 := + Error_Msg_File_1 := ALIs.Table (PSD_Table (Prio).Afile).Sfile; - Error_Msg_Name_2 := ALIs.Table (F).Sfile; + Error_Msg_File_2 := ALIs.Table (F).Sfile; Error_Msg_Nat_1 := PSD_Table (Prio).Loc; Error_Msg_Nat_2 := DTK.PSD_Pragma_Line; Consistency_Error_Msg - ("overlapping priority ranges at %:# and %:#"); + ("overlapping priority ranges at {:# and {:#"); exit Find_Overlapping; end if; @@ -494,14 +480,14 @@ package body Bcheck is -- Issue warning, not one of the safe cases else - Error_Msg_Name_1 := UR.Sfile; + Error_Msg_File_1 := UR.Sfile; Error_Msg - ("?% has dynamic elaboration checks " & + ("?{ has dynamic elaboration checks " & "and with's"); - Error_Msg_Name_1 := WU.Sfile; + Error_Msg_File_1 := WU.Sfile; Error_Msg - ("? % which has static elaboration " & + ("? { which has static elaboration " & "checks"); Warnings_Detected := Warnings_Detected - 1; @@ -535,11 +521,11 @@ package body Bcheck is begin for A2 in A1 + 1 .. ALIs.Last loop if ALIs.Table (A2).Float_Format /= Format then - Error_Msg_Name_1 := ALIs.Table (A1).Sfile; - Error_Msg_Name_2 := ALIs.Table (A2).Sfile; + Error_Msg_File_1 := ALIs.Table (A1).Sfile; + Error_Msg_File_2 := ALIs.Table (A2).Sfile; Consistency_Error_Msg - ("% and % compiled with different " & + ("{ and { compiled with different " & "floating-point representations"); exit Find_Format; end if; @@ -614,13 +600,13 @@ package body Bcheck is Loc (Inum) := Lnum; elsif Istate (Inum) /= Stat then - Error_Msg_Name_1 := ALIs.Table (Afile (Inum)).Sfile; - Error_Msg_Name_2 := ALIs.Table (F).Sfile; + Error_Msg_File_1 := ALIs.Table (Afile (Inum)).Sfile; + Error_Msg_File_2 := ALIs.Table (F).Sfile; Error_Msg_Nat_1 := Loc (Inum); Error_Msg_Nat_2 := Lnum; Consistency_Error_Msg - ("inconsistent interrupt states at %:# and %:#"); + ("inconsistent interrupt states at {:# and {:#"); end if; end loop; end loop; @@ -649,11 +635,11 @@ package body Bcheck is if ALIs.Table (A2).Locking_Policy /= ' ' and ALIs.Table (A2).Locking_Policy /= Policy then - Error_Msg_Name_1 := ALIs.Table (A1).Sfile; - Error_Msg_Name_2 := ALIs.Table (A2).Sfile; + Error_Msg_File_1 := ALIs.Table (A1).Sfile; + Error_Msg_File_2 := ALIs.Table (A2).Sfile; Consistency_Error_Msg - ("% and % compiled with different locking policies"); + ("{ and { compiled with different locking policies"); exit Find_Policy; end if; end loop; @@ -733,11 +719,11 @@ package body Bcheck is and then ALIs.Table (A2).Queuing_Policy /= Policy then - Error_Msg_Name_1 := ALIs.Table (A1).Sfile; - Error_Msg_Name_2 := ALIs.Table (A2).Sfile; + Error_Msg_File_1 := ALIs.Table (A1).Sfile; + Error_Msg_File_2 := ALIs.Table (A2).Sfile; Consistency_Error_Msg - ("% and % compiled with different queuing policies"); + ("{ and { compiled with different queuing policies"); exit Find_Policy; end if; end loop; @@ -786,7 +772,7 @@ package body Bcheck is -- in the case of a parameter restriction). declare - M1 : constant String := "% has restriction "; + M1 : constant String := "{ has restriction "; S : constant String := Restriction_Id'Image (R); M2 : String (1 .. 200); -- big enough! P : Integer; @@ -808,7 +794,7 @@ package body Bcheck is P := P + 5; end if; - Error_Msg_Name_1 := ALIs.Table (A).Sfile; + Error_Msg_File_1 := ALIs.Table (A).Sfile; Consistency_Error_Msg (M2 (1 .. P - 1)); Consistency_Error_Msg ("but the following files violate this restriction:"); @@ -858,8 +844,8 @@ package body Bcheck is if R in All_Boolean_Restrictions then Print_Restriction_File (R); - Error_Msg_Name_1 := T.Sfile; - Consistency_Error_Msg (" %"); + Error_Msg_File_1 := T.Sfile; + Consistency_Error_Msg (" {"); -- Case of Parameter restriction where violation -- count exceeds restriction value, print file @@ -871,12 +857,12 @@ package body Bcheck is Cumulative_Restrictions.Value (R) then Print_Restriction_File (R); - Error_Msg_Name_1 := T.Sfile; + Error_Msg_File_1 := T.Sfile; Error_Msg_Nat_1 := Int (T.Restrictions.Count (R)); if T.Restrictions.Unknown (R) then Consistency_Error_Msg - (" % (count = at least #)"); + (" { (count = at least #)"); else Consistency_Error_Msg (" % (count = #)"); @@ -895,7 +881,8 @@ package body Bcheck is for ND in No_Deps.First .. No_Deps.Last loop declare - ND_Unit : constant Name_Id := No_Deps.Table (ND).No_Dep_Unit; + ND_Unit : constant Name_Id := + No_Deps.Table (ND).No_Dep_Unit; begin for J in ALIs.First .. ALIs.Last loop @@ -908,11 +895,13 @@ package body Bcheck is U : Unit_Record renames Units.Table (K); begin for L in U.First_With .. U.Last_With loop - if Same_Unit (Withs.Table (L).Uname, ND_Unit) then - Error_Msg_Name_1 := U.Uname; - Error_Msg_Name_2 := ND_Unit; + if Same_Unit + (Withs.Table (L).Uname, ND_Unit) + then + Error_Msg_File_1 := U.Sfile; + Error_Msg_Name_1 := ND_Unit; Consistency_Error_Msg - ("unit & violates restriction " & + ("file { violates restriction " & "No_Dependence => %"); end if; end loop; @@ -937,10 +926,10 @@ package body Bcheck is if ALIs.Table (A1).Zero_Cost_Exceptions /= ALIs.Table (ALIs.First).Zero_Cost_Exceptions then - Error_Msg_Name_1 := ALIs.Table (A1).Sfile; - Error_Msg_Name_2 := ALIs.Table (ALIs.First).Sfile; + Error_Msg_File_1 := ALIs.Table (A1).Sfile; + Error_Msg_File_2 := ALIs.Table (ALIs.First).Sfile; - Consistency_Error_Msg ("% and % compiled with different " + Consistency_Error_Msg ("{ and { compiled with different " & "exception handling mechanisms"); end if; end loop Check_Mechanism; @@ -963,13 +952,13 @@ package body Bcheck is for K in Boolean loop if K then Name_Buffer (Name_Len) := 'b'; - else Name_Buffer (Name_Len) := 's'; end if; declare - Info : constant Int := Get_Name_Table_Info (Name_Find); + Unit : constant Unit_Name_Type := Name_Find; + Info : constant Int := Get_Name_Table_Info (Unit); begin if Info /= 0 then @@ -1010,11 +999,11 @@ package body Bcheck is or else ALIs.Table (A).Ver (1 .. VL) /= ALIs.Table (ALIs.First).Ver (1 .. VL) then - Error_Msg_Name_1 := ALIs.Table (A).Sfile; - Error_Msg_Name_2 := ALIs.Table (ALIs.First).Sfile; + Error_Msg_File_1 := ALIs.Table (A).Sfile; + Error_Msg_File_2 := ALIs.Table (ALIs.First).Sfile; Consistency_Error_Msg - ("% and % compiled with different GNAT versions"); + ("{ and { compiled with different GNAT versions"); end if; end loop; end Check_Versions; @@ -1051,7 +1040,7 @@ package body Bcheck is -- Same_Unit -- --------------- - function Same_Unit (U1 : Name_Id; U2 : Name_Id) return Boolean is + function Same_Unit (U1 : Unit_Name_Type; U2 : Name_Id) return Boolean is begin -- Note, the string U1 has a terminating %s or %b, U2 does not diff --git a/gcc/ada/binde.adb b/gcc/ada/binde.adb index 5bfccbfa300..7479e51d346 100644 --- a/gcc/ada/binde.adb +++ b/gcc/ada/binde.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- -- @@ -266,7 +266,7 @@ package body Binde is procedure Elab_Error_Msg (S : Successor_Id); -- Given a successor link, outputs an error message of the form - -- "& must be elaborated before & ..." where ... is the reason. + -- "$ must be elaborated before $ ..." where ... is the reason. procedure Gather_Dependencies; -- Compute dependencies, building the Succ and UNR tables @@ -911,17 +911,17 @@ package body Binde is -- Here we want to generate output - Error_Msg_Name_1 := Units.Table (SL.Before).Uname; + Error_Msg_Unit_1 := Units.Table (SL.Before).Uname; if SL.Elab_Body then - Error_Msg_Name_2 := Units.Table (Corresponding_Body (SL.After)).Uname; + Error_Msg_Unit_2 := Units.Table (Corresponding_Body (SL.After)).Uname; else - Error_Msg_Name_2 := Units.Table (SL.After).Uname; + Error_Msg_Unit_2 := Units.Table (SL.After).Uname; end if; - Error_Msg_Output (" & must be elaborated before &", Info => True); + Error_Msg_Output (" $ must be elaborated before $", Info => True); - Error_Msg_Name_1 := Units.Table (SL.Reason_Unit).Uname; + Error_Msg_Unit_1 := Units.Table (SL.Reason_Unit).Uname; case SL.Reason is when Withed => @@ -931,30 +931,30 @@ package body Binde is when Elab => Error_Msg_Output - (" reason: pragma Elaborate in unit &", + (" reason: pragma Elaborate in unit $", Info => True); when Elab_All => Error_Msg_Output - (" reason: pragma Elaborate_All in unit &", + (" reason: pragma Elaborate_All in unit $", Info => True); when Elab_All_Desirable => Error_Msg_Output - (" reason: implicit Elaborate_All in unit &", + (" reason: implicit Elaborate_All in unit $", Info => True); Error_Msg_Output - (" recompile & with -gnatwl for full details", + (" recompile $ with -gnatwl for full details", Info => True); when Elab_Desirable => Error_Msg_Output - (" reason: implicit Elaborate in unit &", + (" reason: implicit Elaborate in unit $", Info => True); Error_Msg_Output - (" recompile & with -gnatwl for full details", + (" recompile $ with -gnatwl for full details", Info => True); when Spec_First => @@ -966,19 +966,21 @@ package body Binde is Write_Elab_All_Chain (S); if SL.Elab_Body then - Error_Msg_Name_1 := Units.Table (SL.Before).Uname; - Error_Msg_Name_2 := Units.Table (SL.After).Uname; + Error_Msg_Unit_1 := Units.Table (SL.Before).Uname; + Error_Msg_Unit_2 := Units.Table (SL.After).Uname; Error_Msg_Output - (" & must therefore be elaborated before &", + (" $ must therefore be elaborated before $", True); - Error_Msg_Name_1 := Units.Table (SL.After).Uname; + Error_Msg_Unit_1 := Units.Table (SL.After).Uname; Error_Msg_Output - (" (because & has a pragma Elaborate_Body)", + (" (because $ has a pragma Elaborate_Body)", True); end if; - Write_Eol; + if not Zero_Formatting then + Write_Eol; + end if; end Elab_Error_Msg; --------------------- @@ -1155,9 +1157,9 @@ package body Binde is -- obsolete unit with's a previous (now disappeared) spec. if Get_Name_Table_Info (Withs.Table (W).Uname) = 0 then - Error_Msg_Name_1 := Units.Table (U).Sfile; - Error_Msg_Name_2 := Withs.Table (W).Uname; - Error_Msg ("% depends on & which no longer exists"); + Error_Msg_File_1 := Units.Table (U).Sfile; + Error_Msg_Unit_1 := Withs.Table (W).Uname; + Error_Msg ("{ depends on $ which no longer exists"); goto Next_With; end if; @@ -1403,11 +1405,12 @@ package body Binde is procedure Write_Dependencies is begin - Write_Eol; - Write_Str - (" ELABORATION ORDER DEPENDENCIES"); - Write_Eol; - Write_Eol; + if not Zero_Formatting then + Write_Eol; + Write_Str (" ELABORATION ORDER DEPENDENCIES"); + Write_Eol; + Write_Eol; + end if; Info_Prefix_Suppress := True; @@ -1416,7 +1419,10 @@ package body Binde is end loop; Info_Prefix_Suppress := False; - Write_Eol; + + if not Zero_Formatting then + Write_Eol; + end if; end Write_Dependencies; -------------------------- @@ -1437,8 +1443,8 @@ package body Binde is L := ST.Elab_All_Link; while L /= No_Elab_All_Link loop Nam := Elab_All_Entries.Table (L).Needed_By; - Error_Msg_Name_1 := Nam; - Error_Msg_Output (" &", Info => True); + Error_Msg_Unit_1 := Nam; + Error_Msg_Output (" $", Info => True); Get_Name_String (Nam); @@ -1473,8 +1479,8 @@ package body Binde is L := Elab_All_Entries.Table (L).Next_Elab; end loop; - Error_Msg_Name_1 := After; - Error_Msg_Output (" &", Info => True); + Error_Msg_Unit_1 := After; + Error_Msg_Output (" $", Info => True); end if; end Write_Elab_All_Chain; diff --git a/gcc/ada/binderr.adb b/gcc/ada/binderr.adb index bd30636647a..949c377bcd0 100644 --- a/gcc/ada/binderr.adb +++ b/gcc/ada/binderr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2002 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- -- @@ -24,10 +24,9 @@ -- -- ------------------------------------------------------------------------------ -with Butil; use Butil; -with Namet; use Namet; -with Opt; use Opt; -with Output; use Output; +with Butil; use Butil; +with Opt; use Opt; +with Output; use Output; package body Binderr is @@ -95,8 +94,10 @@ package body Binderr is ---------------------- procedure Error_Msg_Output (Msg : String; Info : Boolean) is - Use_Second_Name : Boolean := False; + Use_Second_File : Boolean := False; + Use_Second_Unit : Boolean := False; Use_Second_Nat : Boolean := False; + Warning : Boolean := False; begin if Warnings_Detected + Errors_Detected > Maximum_Errors then @@ -105,7 +106,16 @@ package body Binderr is return; end if; - if Msg (Msg'First) = '?' then + -- First, check for warnings + + for J in Msg'Range loop + if Msg (J) = '?' then + Warning := True; + exit; + end if; + end loop; + + if Warning then Write_Str ("warning: "); elsif Info then if not Info_Prefix_Suppress then @@ -117,26 +127,31 @@ package body Binderr is for J in Msg'Range loop if Msg (J) = '%' then + Get_Name_String (Error_Msg_Name_1); + Write_Char ('"'); + Write_Str (Name_Buffer (1 .. Name_Len)); + Write_Char ('"'); - if Use_Second_Name then - Get_Name_String (Error_Msg_Name_2); + elsif Msg (J) = '{' then + if Use_Second_File then + Get_Name_String (Error_Msg_File_2); else - Use_Second_Name := True; - Get_Name_String (Error_Msg_Name_1); + Use_Second_File := True; + Get_Name_String (Error_Msg_File_1); end if; Write_Char ('"'); Write_Str (Name_Buffer (1 .. Name_Len)); Write_Char ('"'); - elsif Msg (J) = '&' then + elsif Msg (J) = '$' then Write_Char ('"'); - if Use_Second_Name then - Write_Unit_Name (Error_Msg_Name_2); + if Use_Second_Unit then + Write_Unit_Name (Error_Msg_Unit_2); else - Use_Second_Name := True; - Write_Unit_Name (Error_Msg_Name_1); + Use_Second_Unit := True; + Write_Unit_Name (Error_Msg_Unit_1); end if; Write_Char ('"'); diff --git a/gcc/ada/binderr.ads b/gcc/ada/binderr.ads index bc0c013c312..b4efa23465f 100644 --- a/gcc/ada/binderr.ads +++ b/gcc/ada/binderr.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2003 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,6 +27,7 @@ -- This package contains the routines to output error messages for the binder -- and also the routines for handling fatal error conditions in the binder. +with Namet; use Namet; with Types; use Types; package Binderr is @@ -51,19 +52,19 @@ package Binderr is -- appear which cause the error message circuit to modify the given -- string as follows: - -- Insertion character % (Percent: insert file name from Names table) - -- The character % is replaced by the text for the file name specified - -- by the Name_Id value stored in Error_Msg_Name_1. The name is always - -- enclosed in quotes. A second % may appear in a single message in - -- which case it is similarly replaced by the name which is specified - -- by the Name_Id value stored in Error_Msg_Name_2. + -- Insertion character { (Left brace: insert file name from Names table) + -- The character { is replaced by the text for the file name specified + -- by the File_Name_Type value stored in Error_Msg_File_1. The name is + -- always enclosed in quotes. A second % may appear in a single message + -- in which case it is similarly replaced by the name which is + -- specified by the File_Name_Type value stored in Error_Msg_File_2. - -- Insertion character & (Ampersand: insert unit name from Names table) + -- Insertion character $ (Dollar: insert unit name from Names table) -- The character & is replaced by the text for the unit name specified - -- by the Name_Id value stored in Error_Msg_Name_1. The name is always + -- by the Name_Id value stored in Error_Msg_Unit_1. The name is always -- enclosed in quotes. A second & may appear in a single message in -- which case it is similarly replaced by the name which is specified - -- by the Name_Id value stored in Error_Msg_Name_2. + -- by the Name_Id value stored in Error_Msg_Unit_2. -- Insertion character # (Pound: insert non-negative number in decimal) -- The character # is replaced by the contents of Error_Msg_Nat_1 @@ -83,11 +84,18 @@ package Binderr is -- passed to the error message routine for insertion sequences described -- above. The reason these are passed globally is that the insertion -- mechanism is essentially an untyped one in which the appropriate - -- variables are set dependingon the specific insertion characters used. + -- variables are set depending on the specific insertion characters used. Error_Msg_Name_1 : Name_Id; - Error_Msg_Name_2 : Name_Id; - -- Name_Id values for % insertion characters in message + -- Name_Id value for % insertion characters in message + + Error_Msg_File_1 : File_Name_Type; + Error_Msg_File_2 : File_Name_Type; + -- Name_Id values for { insertion characters in message + + Error_Msg_Unit_1 : Unit_Name_Type; + Error_Msg_Unit_2 : Unit_Name_Type; + -- Name_Id values for $ insertion characters in message Error_Msg_Nat_1 : Nat; Error_Msg_Nat_2 : Nat; diff --git a/gcc/ada/butil.adb b/gcc/ada/butil.adb index fe630890494..dbe0e8e7165 100644 --- a/gcc/ada/butil.adb +++ b/gcc/ada/butil.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2005, 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- -- @@ -24,7 +24,6 @@ -- -- ------------------------------------------------------------------------------ -with Namet; use Namet; with Output; use Output; with Targparm; use Targparm; diff --git a/gcc/ada/butil.ads b/gcc/ada/butil.ads index 4ed78bb7223..f0f6f8afcc8 100644 --- a/gcc/ada/butil.ads +++ b/gcc/ada/butil.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2005, 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- -- @@ -24,7 +24,7 @@ -- -- ------------------------------------------------------------------------------ -with Types; use Types; +with Namet; use Namet; package Butil is diff --git a/gcc/ada/err_vars.ads b/gcc/ada/err_vars.ads index fedeb0718fd..ec85d57e0a7 100644 --- a/gcc/ada/err_vars.ads +++ b/gcc/ada/err_vars.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- 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,6 +27,7 @@ -- This package contains variables common to error reporting packages -- including Errout and Prj.Err. +with Namet; use Namet; with Types; use Types; with Uintp; use Uintp; @@ -120,9 +121,14 @@ package Err_Vars is Error_Msg_Name_3 : Name_Id; -- Name_Id values for % insertion characters in message - Error_Msg_Unit_1 : Name_Id; - Error_Msg_Unit_2 : Name_Id; - -- Name_Id values for $ insertion characters in message + Error_Msg_File_1 : File_Name_Type; + Error_Msg_File_2 : File_Name_Type; + Error_Msg_File_3 : File_Name_Type; + -- File_Name_Type values for { insertion characters in message + + Error_Msg_Unit_1 : Unit_Name_Type; + Error_Msg_Unit_2 : Unit_Name_Type; + -- Unit_Name_Type values for $ insertion characters in message Error_Msg_Node_1 : Node_Id; Error_Msg_Node_2 : Node_Id; diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb index cb508f22c75..9c2a614f78d 100644 --- a/gcc/ada/erroutc.adb +++ b/gcc/ada/erroutc.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- -- @@ -673,32 +673,32 @@ package body Erroutc is procedure Set_Msg_Insertion_File_Name is begin - if Error_Msg_Name_1 = No_Name then + if Error_Msg_File_1 = No_File then null; - elsif Error_Msg_Name_1 = Error_Name then + elsif Error_Msg_File_1 = Error_File_Name then Set_Msg_Blank; Set_Msg_Str ("<error>"); else Set_Msg_Blank; - Get_Name_String (Error_Msg_Name_1); + Get_Name_String (Error_Msg_File_1); Set_Msg_Quote; Set_Msg_Name_Buffer; Set_Msg_Quote; end if; - -- The following assignments ensure that the second and third percent - -- insertion characters will correspond to the Error_Msg_Name_2 and - -- Error_Msg_Name_3 as required. We suppress possible validity checks in - -- case operating in -gnatVa mode, and Error_Msg_Name_2/3 is not needed - -- and has not been set. + -- The following assignments ensure that the second and third { + -- insertion characters will correspond to the Error_Msg_File_2 and + -- Error_Msg_File_3 values and We suppress possible validity checks in + -- case operating in -gnatVa mode, and Error_Msg_File_2 or + -- Error_Msg_File_3 is not needed and has not been set. declare pragma Suppress (Range_Check); begin - Error_Msg_Name_1 := Error_Msg_Name_2; - Error_Msg_Name_2 := Error_Msg_Name_3; + Error_Msg_File_1 := Error_Msg_File_2; + Error_Msg_File_2 := Error_Msg_File_3; end; end Set_Msg_Insertion_File_Name; @@ -857,6 +857,41 @@ package body Erroutc is end; end Set_Msg_Insertion_Name; + ------------------------------------ + -- Set_Msg_Insertion_Name_Literal -- + ------------------------------------ + + procedure Set_Msg_Insertion_Name_Literal is + begin + if Error_Msg_Name_1 = No_Name then + null; + + elsif Error_Msg_Name_1 = Error_Name then + Set_Msg_Blank; + Set_Msg_Str ("<error>"); + + else + Set_Msg_Blank; + Get_Name_String (Error_Msg_Name_1); + Set_Msg_Quote; + Set_Msg_Name_Buffer; + Set_Msg_Quote; + end if; + + -- The following assignments ensure that the second and third % or %% + -- insertion characters will correspond to the Error_Msg_Name_2 and + -- Error_Msg_Name_3 values and We suppress possible validity checks in + -- case operating in -gnatVa mode, and Error_Msg_Name_2 or + -- Error_Msg_Name_3 is not needed and has not been set. + + declare + pragma Suppress (Range_Check); + begin + Error_Msg_Name_1 := Error_Msg_Name_2; + Error_Msg_Name_2 := Error_Msg_Name_3; + end; + end Set_Msg_Insertion_Name_Literal; + ------------------------------------- -- Set_Msg_Insertion_Reserved_Name -- ------------------------------------- diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads index 51934df9547..292a9577d9c 100644 --- a/gcc/ada/erroutc.ads +++ b/gcc/ada/erroutc.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- 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- -- @@ -381,6 +381,8 @@ package Erroutc is -- location to be referenced, and Flag is the location at which the -- flag is posted (used to determine whether to add "in file xxx") + procedure Set_Msg_Insertion_Name_Literal; + procedure Set_Msg_Insertion_Name; -- Handle name insertion (% insertion character) diff --git a/gcc/ada/errutil.adb b/gcc/ada/errutil.adb index 25e18c1f032..f877fafe228 100644 --- a/gcc/ada/errutil.adb +++ b/gcc/ada/errutil.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1991-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1991-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- -- @@ -681,7 +681,12 @@ package body Errutil is -- Check for insertion character if C = '%' then - Set_Msg_Insertion_Name; + if P <= Text'Last and then Text (P) = '%' then + P := P + 1; + Set_Msg_Insertion_Name_Literal; + else + Set_Msg_Insertion_Name; + end if; elsif C = '$' then diff --git a/gcc/ada/errutil.ads b/gcc/ada/errutil.ads index a2688b0d6a1..b79dbe917fd 100644 --- a/gcc/ada/errutil.ads +++ b/gcc/ada/errutil.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 2002-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- -- @@ -49,101 +49,7 @@ package Errutil is -- and the special characters space, comma, period, colon and semicolon, -- apostrophe and parentheses. Special insertion characters can also -- appear which cause the error message circuit to modify the given - -- string as follows: - - -- Ignored insertion characters: the following characters, used as - -- insertion characters by Errout are ignored: '$', '&', and '}'. - -- If present in an error message, they are not output and are not - -- replaced by any text. - - -- Insertion character % (Percent: insert name from Names table) - -- The character % is replaced by the text for the name specified by - -- the Name_Id value stored in Error_Msg_Name_1. A blank precedes - -- the name if it is preceded by a non-blank character other than a - -- left parenthesis. The name is enclosed in quotes unless manual - -- quotation mode is set. If the Name_Id is set to No_Name, then - -- no insertion occurs; if the Name_Id is set to Error_Name, then - -- the string <error> is inserted. A second and third % may appear - -- in a single message, similarly replaced by the names which are - -- specified by the Name_Id values stored in Error_Msg_Name_2 and - -- Error_Msg_Name_3. The names are decoded and cased according to - -- the current identifier casing mode. - - -- Insertion character { (Left brace: insert literally from names table) - -- The character { is treated similarly to %, except that the - -- name is output literally as stored in the names table without - -- adjusting the casing. This can be used for file names and in - -- other situations where the name string is to be output unchanged. - - -- Insertion character * (Asterisk, insert reserved word name) - -- The insertion character * is treated exactly like % except that - -- the resulting name is cased according to the default conventions - -- for reserved words (see package Scans). - - -- Insertion character # (Pound: insert line number reference) - -- The character # is replaced by the string indicating the source - -- position stored in Error_Msg_Sloc. There are two cases: - -- - -- for locations in current file: at line nnn:ccc - -- for locations in other files: at filename:nnn:ccc - -- - -- By convention, the # insertion character is only used at the end - -- of an error message, so the above strings only appear as the last - -- characters of an error message. - - -- Insertion character @ (At: insert column number reference) - -- The character @ is replaced by null if the RM_Column_Check mode is - -- off (False). If the switch is on (True), then @ is replaced by the - -- text string " in column nnn" where nnn is the decimal representation - -- of the column number stored in Error_Msg_Col plus one (the plus one - -- is because the number is stored 0-origin and displayed 1-origin). - - -- Insertion character ^ (Carret: insert integer value) - -- The character ^ is replaced by the decimal conversion of the Uint - -- value stored in Error_Msg_Uint_1, with a possible leading minus. - -- A second ^ may occur in the message, in which case it is replaced - -- by the decimal conversion of the Uint value in Error_Msg_Uint_2. - - -- Insertion character ! (Exclamation: unconditional message) - -- The character ! appearing as the last character of a message makes - -- the message unconditional which means that it is output even if it - -- would normally be suppressed. - - -- Insertion character ? (Question: warning message) - -- The character ? appearing anywhere in a message makes the message - -- a warning instead of a normal error message, and the text of the - -- message will be preceded by "Warning:" instead of "Error:" The - -- handling of warnings if further controlled by the Warning_Mode - -- option (-w switch), see package Opt for further details, and - -- also by the current setting from pragma Warnings. This pragma - -- applies only to warnings issued from the semantic phase (not - -- the parser), but currently all relevant warnings are posted - -- by the semantic phase anyway. Messages starting with (style) - -- are also treated as warning messages. - - -- Insertion character A-Z (Upper case letter: Ada reserved word) - -- If two or more upper case letters appear in the message, they are - -- taken as an Ada reserved word, and are converted to the default - -- case for reserved words (see Scans package spec). Surrounding - -- quotes are added unless manual quotation mode is currently set. - - -- Insertion character ` (Backquote: set manual quotation mode) - -- The backquote character always appears in pairs. Each backquote - -- of the pair is replaced by a double quote character. In addition, - -- Any reserved keywords, or name insertions between these backquotes - -- are not surrounded by the usual automatic double quotes. See the - -- section below on manual quotation mode for further details. - - -- Insertion character ' (Quote: literal character) - -- Precedes a character which is placed literally into the message. - -- Used to insert characters into messages that are one of the - -- insertion characters defined here. - - -- Insertion character \ (Backslash: continuation message) - -- Indicates that the message is a continuation of a message - -- previously posted. This is used to ensure that such groups - -- of messages are treated as a unit. The \ character must be - -- the first character of the message text. + -- string. For a full list of these, see the spec of errout. ----------------------------------------------------- -- Format of Messages and Manual Quotation Control -- diff --git a/gcc/ada/exp_tss.adb b/gcc/ada/exp_tss.adb index 65bf431033f..8d7dce3b210 100644 --- a/gcc/ada/exp_tss.adb +++ b/gcc/ada/exp_tss.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- -- @@ -29,7 +29,6 @@ with Einfo; use Einfo; with Elists; use Elists; with Exp_Util; use Exp_Util; with Lib; use Lib; -with Namet; use Namet; with Sem_Util; use Sem_Util; with Sinfo; use Sinfo; diff --git a/gcc/ada/exp_tss.ads b/gcc/ada/exp_tss.ads index 3883d3c5bb6..5e290be7542 100644 --- a/gcc/ada/exp_tss.ads +++ b/gcc/ada/exp_tss.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- 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- -- @@ -26,6 +26,7 @@ -- Type Support Subprogram (TSS) handling +with Namet; use Namet; with Types; use Types; package Exp_Tss is diff --git a/gcc/ada/fmap.adb b/gcc/ada/fmap.adb index 37e1002d3e6..381ef27215f 100644 --- a/gcc/ada/fmap.adb +++ b/gcc/ada/fmap.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-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- -- @@ -24,12 +24,13 @@ -- -- ------------------------------------------------------------------------------ -with GNAT.OS_Lib; use GNAT.OS_Lib; -with Namet; use Namet; -with Opt; use Opt; -with Osint; use Osint; -with Output; use Output; +with Opt; use Opt; +with Osint; use Osint; +with Output; use Output; with Table; +with Types; use Types; + +with System.OS_Lib; use System.OS_Lib; with Unchecked_Conversion; @@ -91,6 +92,9 @@ package body Fmap is -- Hash table to map unit names to file names. Used in conjunction with -- table File_Mapping above. + function Hash (F : File_Name_Type) return Header_Num; + -- Function used to compute hash of file name + package File_Hash_Table is new GNAT.HTable.Simple_HTable ( Header_Num => Header_Num, Element => Int, @@ -115,7 +119,7 @@ package body Fmap is -- Add_Forbidden_File_Name -- ----------------------------- - procedure Add_Forbidden_File_Name (Name : Name_Id) is + procedure Add_Forbidden_File_Name (Name : File_Name_Type) is begin Forbidden_Names.Set (Name, True); end Add_Forbidden_File_Name; @@ -144,6 +148,11 @@ package body Fmap is -- Hash -- ---------- + function Hash (F : File_Name_Type) return Header_Num is + begin + return Header_Num (Int (F) rem Header_Num'Range_Length); + end Hash; + function Hash (F : Unit_Name_Type) return Header_Num is begin return Header_Num (Int (F) rem Header_Num'Range_Length); @@ -163,16 +172,20 @@ package body Fmap is Last : Natural := 0; Uname : Unit_Name_Type; - Fname : Name_Id; - Pname : Name_Id; - - The_Mapping : Mapping; + Fname : File_Name_Type; + Pname : File_Name_Type; - procedure Empty_Tables (Warning : Boolean := True); + procedure Empty_Tables; -- Remove all entries in case of incorrect mapping file - function Find_Name return Name_Id; - -- Return Error_Name for "/", otherwise call Name_Find + function Find_File_Name return File_Name_Type; + -- Return Error_File_Name for "/", otherwise call Name_Find + -- What is this about, explanation required ??? + + function Find_Unit_Name return Unit_Name_Type; + -- Return Error_Unit_Name for "/", otherwise call Name_Find + -- Even more mysterious??? function appeared when Find_Name was split + -- for the two types, but this routine is definitely called! procedure Get_Line; -- Get a line from the mapping file @@ -185,14 +198,8 @@ package body Fmap is -- Empty_Tables -- ------------------ - procedure Empty_Tables (Warning : Boolean := True) is + procedure Empty_Tables is begin - if Warning then - Write_Str ("mapping file """); - Write_Str (File_Name); - Write_Line (""" is not taken into account"); - end if; - Unit_Hash_Table.Reset; File_Hash_Table.Reset; Path_Mapping.Set_Last (0); @@ -200,19 +207,30 @@ package body Fmap is Last_In_Table := 0; end Empty_Tables; - --------------- - -- Find_Name -- - --------------- + -------------------- + -- Find_File_Name -- + -------------------- + + -- Why is only / illegal, why not \ on windows ??? - function Find_Name return Name_Id is + function Find_File_Name return File_Name_Type is begin if Name_Buffer (1 .. Name_Len) = "/" then - return Error_Name; - + return Error_File_Name; else return Name_Find; end if; - end Find_Name; + end Find_File_Name; + + -------------------- + -- Find_Unit_Name -- + -------------------- + + function Find_Unit_Name return Unit_Name_Type is + begin + return Unit_Name_Type (Find_File_Name); + -- very odd ??? + end Find_Unit_Name; -------------- -- Get_Line -- @@ -261,10 +279,10 @@ package body Fmap is Write_Line (""" is truncated"); end Report_Truncated; - -- Start of procedure Initialize + -- Start of processing for Initialize begin - Empty_Tables (Warning => False); + Empty_Tables; Name_Len := File_Name'Length; Name_Buffer (1 .. Name_Len) := File_Name; Read_Source_File (Name_Enter, 0, Hi, Src, Config); @@ -299,7 +317,7 @@ package body Fmap is Name_Len := Last - First + 1; Name_Buffer (1 .. Name_Len) := SP (First .. Last); - Uname := Find_Name; + Uname := Find_Unit_Name; -- Get the file name @@ -316,7 +334,7 @@ package body Fmap is Name_Len := Last - First + 1; Name_Buffer (1 .. Name_Len) := SP (First .. Last); Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); - Fname := Find_Name; + Fname := Find_File_Name; -- Get the path name @@ -332,32 +350,16 @@ package body Fmap is Name_Len := Last - First + 1; Name_Buffer (1 .. Name_Len) := SP (First .. Last); - Pname := Find_Name; + Pname := Find_File_Name; -- Check for duplicate entries if Unit_Hash_Table.Get (Uname) /= No_Entry then - Write_Str ("warning: duplicate entry """); - Write_Str (Get_Name_String (Uname)); - Write_Str (""" in mapping file """); - Write_Str (File_Name); - Write_Line (""""); - The_Mapping := File_Mapping.Table (Unit_Hash_Table.Get (Uname)); - Write_Line (Get_Name_String (The_Mapping.Uname)); - Write_Line (Get_Name_String (The_Mapping.Fname)); Empty_Tables; return; end if; if File_Hash_Table.Get (Fname) /= No_Entry then - Write_Str ("warning: duplicate entry """); - Write_Str (Get_Name_String (Fname)); - Write_Str (""" in mapping file """); - Write_Str (File_Name); - Write_Line (""""); - The_Mapping := Path_Mapping.Table (File_Hash_Table.Get (Fname)); - Write_Line (Get_Name_String (The_Mapping.Uname)); - Write_Line (Get_Name_String (The_Mapping.Fname)); Empty_Tables; return; end if; @@ -371,7 +373,6 @@ package body Fmap is -- Record the length of the two mapping tables Last_In_Table := File_Mapping.Last; - end Initialize; ---------------------- @@ -398,7 +399,7 @@ package body Fmap is begin if Forbidden_Names.Get (File) then - return Error_Name; + return Error_File_Name; end if; Index := File_Hash_Table.Get (File); @@ -414,7 +415,7 @@ package body Fmap is -- Remove_Forbidden_File_Name -- -------------------------------- - procedure Remove_Forbidden_File_Name (Name : Name_Id) is + procedure Remove_Forbidden_File_Name (Name : File_Name_Type) is begin Forbidden_Names.Set (Name, False); end Remove_Forbidden_File_Name; @@ -506,9 +507,9 @@ package body Fmap is end if; for Unit in Last_In_Table + 1 .. File_Mapping.Last loop - Put_Line (File_Mapping.Table (Unit).Uname); - Put_Line (File_Mapping.Table (Unit).Fname); - Put_Line (Path_Mapping.Table (Unit).Fname); + Put_Line (Name_Id (File_Mapping.Table (Unit).Uname)); + Put_Line (Name_Id (File_Mapping.Table (Unit).Fname)); + Put_Line (Name_Id (Path_Mapping.Table (Unit).Fname)); end loop; -- Before closing the file, write the buffer to the file. diff --git a/gcc/ada/fmap.ads b/gcc/ada/fmap.ads index 41d53114c46..17528a57210 100644 --- a/gcc/ada/fmap.ads +++ b/gcc/ada/fmap.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2003, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-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,7 @@ -- This package keeps two mappings: from unit names to file names, -- and from file names to path names. -with Types; use Types; +with Namet; use Namet; package Fmap is @@ -64,12 +64,12 @@ package Fmap is -- for ASIS, for example) to remove any existing mappings from a previous -- compilation. - procedure Add_Forbidden_File_Name (Name : Name_Id); + procedure Add_Forbidden_File_Name (Name : File_Name_Type); -- Indicate that a source file name is forbidden. -- This is used by gnatmake when there are Locally_Removed_Files in -- extending projects. - procedure Remove_Forbidden_File_Name (Name : Name_Id); + procedure Remove_Forbidden_File_Name (Name : File_Name_Type); -- Indicate that a source file name that was forbidden is no longer -- forbidden. Used by gnatmake when a locally removed file is redefined -- in another extending project. diff --git a/gcc/ada/fname-sf.adb b/gcc/ada/fname-sf.adb index 5572037a847..3e714a8c94e 100644 --- a/gcc/ada/fname-sf.adb +++ b/gcc/ada/fname-sf.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -28,8 +28,8 @@ with Casing; use Casing; with Fname; use Fname; with Fname.UF; use Fname.UF; with SFN_Scan; use SFN_Scan; -with Namet; use Namet; with Osint; use Osint; +with Types; use Types; with Unchecked_Conversion; diff --git a/gcc/ada/fname-uf.adb b/gcc/ada/fname-uf.adb index 0ec94050b71..75809de7c9f 100644 --- a/gcc/ada/fname-uf.adb +++ b/gcc/ada/fname-uf.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- -- @@ -28,7 +28,6 @@ with Alloc; with Debug; use Debug; with Fmap; use Fmap; with Krunch; -with Namet; use Namet; with Opt; use Opt; with Osint; use Osint; with Table; @@ -194,7 +193,7 @@ package body Fname.UF is -- Null or error name means that some previous error occurred -- This is an unrecoverable error, so signal it. - if Uname <= Error_Name then + if Uname in Error_Unit_Name_Or_No_Unit_Name then raise Unrecoverable_Error; end if; @@ -434,7 +433,7 @@ package body Fname.UF is Debug_Flag_4); end if; - Fnam := File_Name_Type (Name_Find); + Fnam := Name_Find; -- If we are in the second search of the table, we accept -- the file name without checking, because we know that diff --git a/gcc/ada/fname-uf.ads b/gcc/ada/fname-uf.ads index bf047704231..b0ba0d90b3a 100644 --- a/gcc/ada/fname-uf.ads +++ b/gcc/ada/fname-uf.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- 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- -- @@ -36,6 +36,7 @@ -- to deal with the extra dependencies). with Casing; use Casing; +with Types; use Types; package Fname.UF is diff --git a/gcc/ada/fname.adb b/gcc/ada/fname.adb index 495d7493e6b..880e8164440 100644 --- a/gcc/ada/fname.adb +++ b/gcc/ada/fname.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- -- @@ -33,8 +33,8 @@ with Alloc; with Hostparm; use Hostparm; -with Namet; use Namet; with Table; +with Types; use Types; package body Fname is diff --git a/gcc/ada/fname.ads b/gcc/ada/fname.ads index bb60c75bafc..9e31b991c44 100644 --- a/gcc/ada/fname.ads +++ b/gcc/ada/fname.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2004 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- -- @@ -35,7 +35,7 @@ -- association between source file names and unit names as defined -- (see package Uname for definition of format of unit names). -with Types; use Types; +with Namet; use Namet; package Fname is diff --git a/gcc/ada/lib-sort.adb b/gcc/ada/lib-sort.adb index b5925165542..c20885eb573 100644 --- a/gcc/ada/lib-sort.adb +++ b/gcc/ada/lib-sort.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2005, 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- -- @@ -58,10 +58,10 @@ procedure Sort (Tbl : in out Unit_Ref_Table) is -- at the bottom of the list. They are recognized because they are -- the only ones without a Unit_Name. - if Units.Table (T (C1)).Unit_Name = No_Name then + if Units.Table (T (C1)).Unit_Name = No_Unit_Name then return False; - elsif Units.Table (T (C2)).Unit_Name = No_Name then + elsif Units.Table (T (C2)).Unit_Name = No_Unit_Name then return True; else diff --git a/gcc/ada/lib-util.adb b/gcc/ada/lib-util.adb index 64ddf1766c5..d67b8d0bf7d 100644 --- a/gcc/ada/lib-util.adb +++ b/gcc/ada/lib-util.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2002 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- -- @@ -25,7 +25,6 @@ ------------------------------------------------------------------------------ with Hostparm; -with Namet; use Namet; with Osint.C; use Osint.C; package body Lib.Util is @@ -142,6 +141,16 @@ package body Lib.Util is Info_Buffer_Col := Info_Buffer_Col + Name_Len; end Write_Info_Name; + procedure Write_Info_Name (Name : File_Name_Type) is + begin + Write_Info_Name (Name_Id (Name)); + end Write_Info_Name; + + procedure Write_Info_Name (Name : Unit_Name_Type) is + begin + Write_Info_Name (Name_Id (Name)); + end Write_Info_Name; + -------------------- -- Write_Info_Nat -- -------------------- diff --git a/gcc/ada/lib-util.ads b/gcc/ada/lib-util.ads index 9c29a08f4bc..31f5564498f 100644 --- a/gcc/ada/lib-util.ads +++ b/gcc/ada/lib-util.ads @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-1999 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- -- @@ -54,7 +54,11 @@ package Lib.Util is -- Adds image of N to Info_Buffer with no leading or trailing blanks procedure Write_Info_Name (Name : Name_Id); - -- Adds characters of Name to Info_Buffer + procedure Write_Info_Name (Name : File_Name_Type); + procedure Write_Info_Name (Name : Unit_Name_Type); + -- Adds characters of Name to Info_Buffer. Note that in all cases, the + -- name is written literally from the names table entry without modifying + -- the case, using simply Get_Name_String. procedure Write_Info_Str (Val : String); -- Adds characters of Val to Info_Buffer surrounded by quotes diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index 3c8291915f1..ec47ff95f7f 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-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- -- @@ -29,7 +29,6 @@ with Csets; use Csets; with Elists; use Elists; with Errout; use Errout; with Lib.Util; use Lib.Util; -with Namet; use Namet; with Nlists; use Nlists; with Opt; use Opt; with Restrict; use Restrict; diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index a3d3c5bae46..0a958739c83 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-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- -- @@ -26,7 +26,6 @@ with Ada.Command_Line; use Ada.Command_Line; -with Namet; use Namet; with Osint; use Osint; with Prj.Ext; with Prj.Util; @@ -223,7 +222,7 @@ package body Makeutl is end loop; if Equal_Pos = Start - or else Equal_Pos >= Finish + or else Equal_Pos > Finish then return False; else diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads index b2a75f770f5..d0d443bc453 100644 --- a/gcc/ada/makeutl.ads +++ b/gcc/ada/makeutl.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2004-2006 Free Software Foundation, Inc. -- +-- Copyright (C) 2004-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- -- @@ -24,6 +24,7 @@ -- -- ------------------------------------------------------------------------------ +with Namet; use Namet; with Osint; with Prj; use Prj; with Types; use Types; diff --git a/gcc/ada/nmake.adt b/gcc/ada/nmake.adt index 240d5226446..922baa6e318 100644 --- a/gcc/ada/nmake.adt +++ b/gcc/ada/nmake.adt @@ -6,7 +6,7 @@ -- -- -- T e m p l a t e -- -- -- --- 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- -- @@ -33,6 +33,7 @@ pragma Style_Checks (All_Checks); -- generated automatically in order. with Atree; use Atree; -- body only +with Namet; use Namet; -- spec only with Nlists; use Nlists; -- spec only with Sinfo; use Sinfo; -- body only with Snames; use Snames; -- body only diff --git a/gcc/ada/osint-b.adb b/gcc/ada/osint-b.adb index d7c8e350e69..60fd8f2e819 100644 --- a/gcc/ada/osint-b.adb +++ b/gcc/ada/osint-b.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2006 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-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- -- @@ -24,7 +24,6 @@ -- -- ------------------------------------------------------------------------------ -with Namet; use Namet; with Opt; use Opt; with Targparm; use Targparm; diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb index 8d1a5d40373..a78ab8d8d86 100644 --- a/gcc/ada/osint.adb +++ b/gcc/ada/osint.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- -- @@ -24,22 +24,21 @@ -- -- ------------------------------------------------------------------------------ -with Fmap; use Fmap; -with Gnatvsn; use Gnatvsn; -with Hostparm; -with Namet; use Namet; -with Opt; use Opt; -with Output; use Output; -with Sdefault; use Sdefault; -with Table; -with Targparm; use Targparm; +with Unchecked_Conversion; with System.Case_Util; use System.Case_Util; -with Unchecked_Conversion; - with GNAT.HTable; +with Fmap; use Fmap; +with Gnatvsn; use Gnatvsn; +with Hostparm; +with Opt; use Opt; +with Output; use Output; +with Sdefault; use Sdefault; +with Table; +with Targparm; use Targparm; + package body Osint is Running_Program : Program_Type := Unspecified; @@ -62,21 +61,21 @@ package body Osint is ------------------------------------- -- This package creates a number of source, ALI and object file names - -- that are used to locate the actual file and for the purpose of - -- message construction. These names need not be accessible by Name_Find, - -- and can be therefore created by using routine Name_Enter. The files in - -- question are file names with a prefix directory (ie the files not - -- in the current directory). File names without a prefix directory are - -- entered with Name_Find because special values might be attached to - -- the various Info fields of the corresponding name table entry. + -- that are used to locate the actual file and for the purpose of message + -- construction. These names need not be accessible by Name_Find, and can + -- be therefore created by using routine Name_Enter. The files in question + -- are file names with a prefix directory (ie the files not in the current + -- directory). File names without a prefix directory are entered with + -- Name_Find because special values might be attached to the various Info + -- fields of the corresponding name table entry. ----------------------- -- Local Subprograms -- ----------------------- function Append_Suffix_To_File_Name - (Name : Name_Id; - Suffix : String) return Name_Id; + (Name : File_Name_Type; + Suffix : String) return File_Name_Type; -- Appends Suffix to Name and returns the new name function OS_Time_To_GNAT_Time (T : OS_Time) return Time_Stamp_Type; @@ -84,11 +83,10 @@ package body Osint is function Executable_Prefix return String_Ptr; -- Returns the name of the root directory where the executable is stored. - -- The executable must be located in a directory called "bin", or - -- under root/lib/gcc-lib/..., or under root/libexec/gcc/... Thus, if - -- the executable is stored in directory "/foo/bar/bin", this routine - -- returns "/foo/bar/". Return "" if the location is not recognized - -- as described above. + -- The executable must be located in a directory called "bin", or under + -- root/lib/gcc-lib/..., or under root/libexec/gcc/... For example, if + -- executable is stored in directory "/foo/bar/bin", this routine returns + -- "/foo/bar/". Return "" if location is not recognized as described above. function Update_Path (Path : String_Ptr) return String_Ptr; -- Update the specified path to replace the prefix with the location @@ -99,20 +97,20 @@ package body Osint is T : File_Type; Dir : Natural; Name : String) return File_Name_Type; - -- See if the file N whose name is Name exists in directory Dir. Dir is - -- an index into the Lib_Search_Directories table if T = Library. - -- Otherwise if T = Source, Dir is an index into the - -- Src_Search_Directories table. Returns the File_Name_Type of the - -- full file name if file found, or No_File if not found. + -- See if the file N whose name is Name exists in directory Dir. Dir is an + -- index into the Lib_Search_Directories table if T = Library. Otherwise + -- if T = Source, Dir is an index into the Src_Search_Directories table. + -- Returns the File_Name_Type of the full file name if file found, or + -- No_File if not found. function C_String_Length (S : Address) return Integer; - -- Returns length of a C string. Returns zero for a null address + -- Returns length of a C string (zero for a null address) function To_Path_String_Access (Path_Addr : Address; Path_Len : Integer) return String_Access; - -- Converts a C String to an Ada String. Are we doing this to avoid - -- withing Interfaces.C.Strings ??? + -- Converts a C String to an Ada String. Are we doing this to avoid withing + -- Interfaces.C.Strings ??? ------------------------------ -- Other Local Declarations -- @@ -122,15 +120,13 @@ package body Osint is -- End of line character Number_File_Names : Int := 0; - -- The total number of file names found on command line and placed in - -- File_Names. + -- Number of file names founde on command line and placed in File_Names Look_In_Primary_Directory_For_Current_Main : Boolean := False; - -- When this variable is True, Find_File will only look in - -- the Primary_Directory for the Current_Main file. - -- This variable is always True for the compiler. - -- It is also True for gnatmake, when the soucr name given - -- on the command line has directory information. + -- When this variable is True, Find_File only looks in Primary_Directory + -- for the Current_Main file. This variable is always set to True for the + -- compiler. It is also True for gnatmake, when the soucr name given on + -- the command line has directory information. Current_Full_Source_Name : File_Name_Type := No_File; Current_Full_Source_Stamp : Time_Stamp_Type := Empty_Time_Stamp; @@ -138,9 +134,9 @@ package body Osint is Current_Full_Lib_Stamp : Time_Stamp_Type := Empty_Time_Stamp; Current_Full_Obj_Name : File_Name_Type := No_File; Current_Full_Obj_Stamp : Time_Stamp_Type := Empty_Time_Stamp; - -- Respectively full name (with directory info) and time stamp of - -- the latest source, library and object files opened by Read_Source_File - -- and Read_Library_Info. + -- Respectively full name (with directory info) and time stamp of the + -- latest source, library and object files opened by Read_Source_File and + -- Read_Library_Info. ------------------ -- Search Paths -- @@ -148,13 +144,13 @@ package body Osint is Primary_Directory : constant := 0; -- This is index in the tables created below for the first directory to - -- search in for source or library information files. This is the - -- directory containing the latest main input file (a source file for - -- the compiler or a library file for the binder). + -- search in for source or library information files. This is the directory + -- containing the latest main input file (a source file for the compiler or + -- a library file for the binder). package Src_Search_Directories is new Table.Table ( Table_Component_Type => String_Ptr, - Table_Index_Type => Natural, + Table_Index_Type => Integer, Table_Low_Bound => Primary_Directory, Table_Initial => 10, Table_Increment => 100, @@ -165,7 +161,7 @@ package body Osint is package Lib_Search_Directories is new Table.Table ( Table_Component_Type => String_Ptr, - Table_Index_Type => Natural, + Table_Index_Type => Integer, Table_Low_Bound => Primary_Directory, Table_Initial => 10, Table_Increment => 100, @@ -183,12 +179,11 @@ package body Osint is -- efficiency concern when retrieving full file names or time stamps of -- source files. If the programmer calls Source_File_Data (Cache => True) -- he is guaranteed that the price to retrieve the full name (ie with - -- directory info) or time stamp of the file will be payed only once, - -- the first time the full name is actually searched (or the first time - -- the time stamp is actually retrieved). This is achieved by employing - -- a hash table that stores as a key the File_Name_Type of the file and - -- associates to that File_Name_Type the full file name of the file and its - -- time stamp. + -- directory info) or time stamp of the file will be payed only once, the + -- first time the full name is actually searched (or the first time the + -- time stamp is actually retrieved). This is achieved by employing a hash + -- table that stores as a key the File_Name_Type of the file and associates + -- to that File_Name_Type the full file name and time stamp of the file. File_Cache_Enabled : Boolean := False; -- Set to true if you want the enable the file data caching mechanism @@ -224,11 +219,10 @@ package body Osint is function Smart_File_Stamp (N : File_Name_Type; T : File_Type) return Time_Stamp_Type; - -- Takes the same parameter as the routine above (N is a file name - -- without any prefix directory information) and behaves like File_Stamp - -- except that if File_Cache_Enabled is True this routine looks first in - -- the hash table to see if the file stamp of the file is already - -- available. + -- Takes the same parameter as the routine above (N is a file name without + -- any prefix directory information) and behaves like File_Stamp except + -- that if File_Cache_Enabled is True this routine looks first in the hash + -- table to see if the file stamp of the file is already available. ----------------------------- -- Add_Default_Search_Dirs -- @@ -327,17 +321,15 @@ package body Osint is Curr := Curr + Actual_Len; end loop; - -- We are done with the file, so we close it + -- We are done with the file, so we close it (ignore any error on + -- the close, since we have successfully read the file). Close (File_FD, Status); - -- We ignore any error here, because we have successfully read the - -- file. -- Now, we read line by line First := 1; Curr := 0; - while Curr < Len loop Ch := S (Curr + 1); @@ -451,8 +443,8 @@ package body Osint is -- For the compiler, if --RTS= was specified, add the runtime -- directories. - if RTS_Src_Path_Name /= null and then - RTS_Lib_Path_Name /= null + if RTS_Src_Path_Name /= null + and then RTS_Lib_Path_Name /= null then Add_Search_Dirs (RTS_Src_Path_Name, Include); Add_Search_Dirs (RTS_Lib_Path_Name, Objects); @@ -515,9 +507,8 @@ package body Osint is begin Number_File_Names := Number_File_Names + 1; - -- As Add_File may be called for mains specified inside - -- a project file, File_Names may be too short and needs - -- to be extended. + -- As Add_File may be called for mains specified inside a project file, + -- File_Names may be too short and needs to be extended. if Number_File_Names > File_Names'Last then File_Names := new File_Name_Array'(File_Names.all & File_Names.all); @@ -589,8 +580,8 @@ package body Osint is -------------------------------- function Append_Suffix_To_File_Name - (Name : Name_Id; - Suffix : String) return Name_Id + (Name : File_Name_Type; + Suffix : String) return File_Name_Type is begin Get_Name_String (Name); @@ -722,6 +713,7 @@ package body Osint is function Executable_Name (Name : File_Name_Type) return File_Name_Type is Exec_Suffix : String_Access; + begin if Name = No_File then return No_File; @@ -741,13 +733,12 @@ package body Osint is Buffer : String := Name_Buffer (1 .. Name_Len); begin - -- Get the file name in canonical case to accept as is - -- names ending with ".EXE" on VMS and Windows. + -- Get the file name in canonical case to accept as is names + -- ending with ".EXE" on VMS and Windows. Canonical_Case_File_Name (Buffer); - -- If the Executable does not end with the executable - -- suffix, add it. + -- If Executable does not end with the executable suffix, add it if Buffer'Length <= Exec_Suffix'Length or else @@ -810,6 +801,7 @@ package body Osint is ----------------------- function Executable_Prefix return String_Ptr is + function Get_Install_Dir (Exec : String) return String_Ptr; -- S is the executable name preceeded by the absolute or relative -- path, e.g. "c:\usr\bin\gcc.exe" or "..\bin\gcc". @@ -866,7 +858,7 @@ package body Osint is -- directory prefix. return Get_Install_Dir - (GNAT.OS_Lib.Locate_Exec_On_Path (Exec_Name.all).all); + (System.OS_Lib.Locate_Exec_On_Path (Exec_Name.all).all); end Executable_Prefix; ------------------ @@ -950,6 +942,11 @@ package body Osint is end if; end File_Stamp; + function File_Stamp (Name : Path_Name_Type) return Time_Stamp_Type is + begin + return File_Stamp (File_Name_Type (Name)); + end File_Stamp; + --------------- -- Find_File -- --------------- @@ -970,7 +967,7 @@ package body Osint is -- If we are looking for a config file, look only in the current -- directory, i.e. return input argument unchanged. Also look -- only in the current directory if we are looking for a .dg - -- file (happens in -gnatD mode) + -- file (happens in -gnatD mode). if T = Config or else (Debug_Generated_Code @@ -1002,10 +999,11 @@ package body Osint is -- corresponding path name if File /= No_File then + -- For locally removed file, Error_Name is returned; then -- return No_File, indicating the file is not a source. - if File = Error_Name then + if File = Error_File_Name then return No_File; else @@ -1051,8 +1049,8 @@ package body Osint is procedure Find_Program_Name is Command_Name : String (1 .. Len_Arg (0)); - Cindex1 : Integer := Command_Name'First; - Cindex2 : Integer := Command_Name'Last; + Cindex1 : Integer := Command_Name'First; + Cindex2 : Integer := Command_Name'Last; begin Fill_Arg (Command_Name'Address, 0); @@ -1276,10 +1274,8 @@ package body Osint is -- We first verify if there is a directory Include_Search_Dir -- containing default search directories - Result_Search_Dir - := Read_Default_Search_Dirs (Norm_Search_Dir, - Search_File, - null); + Result_Search_Dir := + Read_Default_Search_Dirs (Norm_Search_Dir, Search_File, null); Default_Search_Dir := new String'(Norm_Search_Dir.all & Default_Suffix_Dir.all); Free (Norm_Search_Dir); @@ -1421,12 +1417,11 @@ package body Osint is Suppress_Options := (others => False); -- Reserve the first slot in the search paths table. This is the - -- directory of the main source file or main library file and is - -- filled in by each call to Next_Main_Source/Next_Main_Lib_File with - -- the directory specified for this main source or library file. This - -- is the directory which is searched first by default. This default - -- search is inhibited by the option -I- for both source and library - -- files. + -- directory of the main source file or main library file and is filled + -- in by each call to Next_Main_Source/Next_Main_Lib_File with the + -- directory specified for this main source or library file. This is the + -- directory which is searched first by default. This default search is + -- inhibited by the option -I- for both source and library files. Src_Search_Directories.Set_Last (Primary_Directory); Src_Search_Directories.Table (Primary_Directory) := new String'(""); @@ -1687,7 +1682,7 @@ package body Osint is Name_Len := File_Name'Last - Fptr + 1; Name_Buffer (1 .. Name_Len) := File_Name (Fptr .. File_Name'Last); Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); - Current_Main := File_Name_Type (Name_Find); + Current_Main := Name_Find; -- In the gnatmake case, the main file may have not have the -- extension. Try ".adb" first then ".ads" @@ -1698,7 +1693,8 @@ package body Osint is begin if Strip_Suffix (Orig_Main) = Orig_Main then - Current_Main := Append_Suffix_To_File_Name (Orig_Main, ".adb"); + Current_Main := + Append_Suffix_To_File_Name (Orig_Main, ".adb"); if Full_Source_Name (Current_Main) = No_File then Current_Main := @@ -1868,8 +1864,8 @@ package body Osint is Find_Program_Name; - -- Find the target prefix if any, for the cross compilation case - -- for instance in "alpha-dec-vxworks-gcc" the target prefix is + -- Find the target prefix if any, for the cross compilation case. + -- For instance in "alpha-dec-vxworks-gcc" the target prefix is -- "alpha-dec-vxworks-" while Name_Len > 0 loop @@ -1972,14 +1968,13 @@ package body Osint is Prev_Was_Separator := True; Nb_Relative_Dir := 0; for J in 1 .. Len loop - if S (J) in ASCII.NUL .. ASCII.US - or else S (J) = ' ' - then + if S (J) in ASCII.NUL .. ASCII.US or else S (J) = ' ' then S (J) := Path_Separator; end if; if S (J) = Path_Separator then Prev_Was_Separator := True; + else if Prev_Was_Separator and then Is_Relative (S.all, J) then Nb_Relative_Dir := Nb_Relative_Dir + 1; @@ -2076,8 +2071,7 @@ package body Osint is if Current_Full_Obj_Stamp (1) = ' ' then - -- When the library is readonly, always assume that - -- the object is consistent. + -- When the library is readonly always assume object is consistent if Is_Readonly_Library (Current_Full_Lib_Name) then Current_Full_Obj_Stamp := Current_Full_Lib_Stamp; @@ -2085,6 +2079,7 @@ package body Osint is elsif Fatal_Err then Get_Name_String (Current_Full_Obj_Name); Close (Lib_FD, Status); + -- No need to check the status, we fail anyway Fail ("Cannot find: ", Name_Buffer (1 .. Name_Len)); @@ -2174,8 +2169,8 @@ package body Osint is if Current_Full_Source_Name = No_File then - -- If we were trying to access the main file and we could not - -- find it we have an error. + -- If we were trying to access the main file and we could not find + -- it, we have an error. if N = Current_Main then Get_Name_String (N); @@ -2573,7 +2568,7 @@ package body Osint is pragma Import (C, To_Canonical_File_Spec, "__gnat_to_canonical_file_spec"); - C_Host_File : String (1 .. Host_File'Length + 1); + C_Host_File : String (1 .. Host_File'Length + 1); Canonical_File_Addr : Address; Canonical_File_Len : Integer; @@ -2749,8 +2744,7 @@ package body Osint is begin In_String (1 .. In_Length) := Path.all; In_String (In_Length + 1) := ASCII.NUL; - Result_Ptr := C_Update_Path (In_String'Address, - Component_Name'Address); + Result_Ptr := C_Update_Path (In_String'Address, Component_Name'Address); Result_Length := Strlen (Result_Ptr); Out_String := new String (1 .. Result_Length); diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads index 8af2ef64608..c31220cc1c4 100644 --- a/gcc/ada/osint.ads +++ b/gcc/ada/osint.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- 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,11 +27,13 @@ -- This package contains the low level, operating system routines used in the -- compiler and binder for command line processing and file input output. -with GNAT.OS_Lib; use GNAT.OS_Lib; -with System; use System; -with Types; use Types; +with Namet; use Namet; +with Types; use Types; -pragma Elaborate_All (GNAT.OS_Lib); +with System.OS_Lib; use System.OS_Lib; +with System; use System; + +pragma Elaborate_All (System.OS_Lib); -- For the call to function Get_Target_Object_Suffix in the private part package Osint is @@ -150,10 +152,13 @@ package Osint is -- Same as above, with String parameters function File_Stamp (Name : File_Name_Type) return Time_Stamp_Type; - -- Returns the time stamp of file Name. Name should include relative - -- path information in order to locate it. If the source file cannot be - -- opened, or Name = No_File, and all blank time stamp is returned (this is - -- not an error situation). + -- Returns the time stamp of file Name. Name should include relative path + -- information in order to locate it. If the source file cannot be opened, + -- or Name = No_File, and all blank time stamp is returned (this is not an + -- error situation). + + function File_Stamp (Name : Path_Name_Type) return Time_Stamp_Type; + -- Same as above for a path name type String_Access_List is array (Positive range <>) of String_Access; -- Deferenced type used to return a list of file specs in @@ -376,8 +381,8 @@ package Osint is function Full_Source_Name (N : File_Name_Type) return File_Name_Type; function Source_File_Stamp (N : File_Name_Type) return Time_Stamp_Type; - -- Returns the full name/time stamp of the source file whose simple name is - -- N which should not include path information. Note that if the file + -- Returns the full name/time stamp of the source file whose simple name + -- is N which should not include path information. Note that if the file -- cannot be located No_File is returned for the first routine and an all -- blank time stamp is returned for the second (this is not an error -- situation). The full name includes appropriate directory information. @@ -491,13 +496,12 @@ package Osint is function Full_Lib_File_Name (N : File_Name_Type) return File_Name_Type; function Library_File_Stamp (N : File_Name_Type) return Time_Stamp_Type; - -- Returns the full name/time stamp of library file N. N should not - -- include path information. Note that if the file cannot be located - -- No_File is returned for the first routine and an all blank time stamp - -- is returned for the second (this is not an error situation). The - -- full name includes the appropriate directory information. The library - -- file directory lookup penalty is incurred every single time this - -- routine is called. + -- Returns the full name/time stamp of library file N. N should not include + -- path information. Note that if the file cannot be located No_File is + -- returned for the first routine and an all blank time stamp is returned + -- for the second (this is not an error situation). The full name includes + -- the appropriate directory information. The library file directory lookup + -- penalty is incurred every single time this routine is called. function Lib_File_Name (Source_File : File_Name_Type; @@ -601,7 +605,7 @@ private -- length in Name_Len), and place the resulting descriptor in Fdesc. Issue -- message and exit with fatal error if file cannot be created. The Fmode -- parameter is set to either Text or Binary (for details see description - -- of GNAT.OS_Lib.Create_File). + -- of System.OS_Lib.Create_File). type Program_Type is (Compiler, Binder, Make, Gnatls, Unspecified); -- Program currently running diff --git a/gcc/ada/par-load.adb b/gcc/ada/par-load.adb index d73546843bb..f924523d87d 100644 --- a/gcc/ada/par-load.adb +++ b/gcc/ada/par-load.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- -- @@ -147,7 +147,7 @@ begin -- If we have no unit name, things are seriously messed up by previous -- errors, and we should not try to continue compilation. - if Unit_Name (Cur_Unum) = No_Name then + if Unit_Name (Cur_Unum) = No_Unit_Name then raise Unrecoverable_Error; end if; @@ -170,7 +170,7 @@ begin or not Same_File_Name_Except_For_Case (File_Name, Unit_File_Name (Cur_Unum))) then - Error_Msg_Name_1 := File_Name; + Error_Msg_File_1 := File_Name; Error_Msg ("?file name does not match unit name, should be{", Sloc (Curunit)); end if; @@ -184,8 +184,8 @@ begin and then Expected_Unit (Cur_Unum) /= Unit_Name (Cur_Unum) then Loc := Error_Location (Cur_Unum); - Error_Msg_Name_1 := Unit_File_Name (Cur_Unum); - Get_Name_String (Error_Msg_Name_1); + Error_Msg_File_1 := Unit_File_Name (Cur_Unum); + Get_Name_String (Error_Msg_File_1); -- Check for predefined file case @@ -200,12 +200,12 @@ begin Name_Buffer (1) = 'g') then declare - Expect_Name : constant Name_Id := Expected_Unit (Cur_Unum); - Actual_Name : constant Name_Id := Unit_Name (Cur_Unum); + Expect_Name : constant Unit_Name_Type := Expected_Unit (Cur_Unum); + Actual_Name : constant Unit_Name_Type := Unit_Name (Cur_Unum); begin - Error_Msg_Name_1 := Expect_Name; - Error_Msg ("% is not a predefined library unit!", Loc); + Error_Msg_Unit_1 := Expect_Name; + Error_Msg ("$$ is not a predefined library unit!", Loc); -- In the predefined file case, we know the user did not -- construct their own package, but we got the wrong one. @@ -222,15 +222,15 @@ begin -- of misspelling of predefined unit names without needing -- a full list of them. - -- Before actually issinying the message, we will check that the + -- Before actually issuing the message, we will check that the -- unit name is indeed a plausible misspelling of the one we got. if Is_Bad_Spelling_Of (Found => Get_Name_String (Expect_Name), Expect => Get_Name_String (Actual_Name)) then - Error_Msg_Name_1 := Actual_Name; - Error_Msg ("possible misspelling of %!", Loc); + Error_Msg_Unit_1 := Actual_Name; + Error_Msg ("possible misspelling of $$!", Loc); end if; end; @@ -319,7 +319,7 @@ begin Spec_Name := Get_Parent_Spec_Name (Unit_Name (Cur_Unum)); - if Spec_Name /= No_Name then + if Spec_Name /= No_Unit_Name then Unum := Load_Unit (Load_Name => Spec_Name, diff --git a/gcc/ada/prj-attr.adb b/gcc/ada/prj-attr.adb index 5b109001800..244e228a609 100644 --- a/gcc/ada/prj-attr.adb +++ b/gcc/ada/prj-attr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-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- -- @@ -24,7 +24,6 @@ -- -- ------------------------------------------------------------------------------ -with Namet; use Namet; with Osint; with Prj.Com; use Prj.Com; with System.Case_Util; use System.Case_Util; diff --git a/gcc/ada/prj-dect.adb b/gcc/ada/prj-dect.adb index 3c70614f7c2..13889a4b4d9 100644 --- a/gcc/ada/prj-dect.adb +++ b/gcc/ada/prj-dect.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2006, Free Software Foundation, Inc -- +-- Copyright (C) 2001-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- -- @@ -25,7 +25,6 @@ ------------------------------------------------------------------------------ with Err_Vars; use Err_Vars; -with Namet; use Namet; with Opt; use Opt; with Prj.Err; use Prj.Err; with Prj.Strt; use Prj.Strt; @@ -209,7 +208,7 @@ package body Prj.Dect is if not Ignore then Error_Msg_Name_1 := Token_Name; - Error_Msg ("undefined attribute {", Token_Ptr); + Error_Msg ("undefined attribute %%", Token_Ptr); end if; end if; @@ -1131,7 +1130,7 @@ package body Prj.Dect is and then Token_Name /= Name_Of (Package_Declaration, In_Tree) then Error_Msg_Name_1 := Name_Of (Package_Declaration, In_Tree); - Error_Msg ("expected {", Token_Ptr); + Error_Msg ("expected %", Token_Ptr); end if; if Token /= Tok_Semicolon then @@ -1252,13 +1251,13 @@ package body Prj.Dect is Current_Package : Project_Node_Id) is Expression_Location : Source_Ptr; - String_Type_Name : Name_Id := No_Name; - Project_String_Type_Name : Name_Id := No_Name; - Type_Location : Source_Ptr := No_Location; - Project_Location : Source_Ptr := No_Location; - Expression : Project_Node_Id := Empty_Node; + String_Type_Name : Name_Id := No_Name; + Project_String_Type_Name : Name_Id := No_Name; + Type_Location : Source_Ptr := No_Location; + Project_Location : Source_Ptr := No_Location; + Expression : Project_Node_Id := Empty_Node; Variable_Name : constant Name_Id := Token_Name; - OK : Boolean := True; + OK : Boolean := True; begin Variable := diff --git a/gcc/ada/prj-err.adb b/gcc/ada/prj-err.adb index 3f4fd0c10e1..7bcc64c6701 100644 --- a/gcc/ada/prj-err.adb +++ b/gcc/ada/prj-err.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2002-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2002-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- -- @@ -24,7 +24,6 @@ -- -- ------------------------------------------------------------------------------ -with Namet; use Namet; with Output; use Output; with Stringt; use Stringt; diff --git a/gcc/ada/prj-makr.adb b/gcc/ada/prj-makr.adb index 75f4589dfc3..6606afbe12d 100644 --- a/gcc/ada/prj-makr.adb +++ b/gcc/ada/prj-makr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-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- -- @@ -25,7 +25,6 @@ ------------------------------------------------------------------------------ with Csets; -with Namet; use Namet; with Opt; with Output; with Osint; use Osint; @@ -40,10 +39,10 @@ with Table; use Table; with Ada.Characters.Handling; use Ada.Characters.Handling; with GNAT.Directory_Operations; use GNAT.Directory_Operations; -with GNAT.Regexp; use GNAT.Regexp; with System.Case_Util; use System.Case_Util; with System.CRTL; +with System.Regexp; use System.Regexp; package body Prj.Makr is diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index 938d394b42a..f58e59f8748 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-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- -- @@ -25,7 +25,6 @@ ------------------------------------------------------------------------------ with Err_Vars; use Err_Vars; -with Namet; use Namet; with Opt; use Opt; with Osint; use Osint; with Output; use Output; @@ -38,19 +37,19 @@ with Sinput.P; use Sinput.P; with Snames; with Table; -with Ada.Characters.Handling; use Ada.Characters.Handling; -with Ada.Exceptions; use Ada.Exceptions; +with Ada.Characters.Handling; use Ada.Characters.Handling; +with Ada.Exceptions; use Ada.Exceptions; -with GNAT.Directory_Operations; use GNAT.Directory_Operations; +with GNAT.Directory_Operations; use GNAT.Directory_Operations; -with System.HTable; use System.HTable; +with System.HTable; use System.HTable; package body Prj.Part is Buffer : String_Access; Buffer_Last : Natural := 0; - Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator; + Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator; type Extension_Origin is (None, Extending_Simple, Extending_All); -- Type of parameter From_Extended for procedures Parse_Single_Project and @@ -65,7 +64,7 @@ package body Prj.Part is No_With : constant With_Id := 0; type With_Record is record - Path : Name_Id; + Path : File_Name_Type; Location : Source_Ptr; Limited_With : Boolean; Node : Project_Node_Id; @@ -85,10 +84,11 @@ package body Prj.Part is -- name of the current project has been extablished. type Names_And_Id is record - Path_Name : Name_Id; - Canonical_Path_Name : Name_Id; + Path_Name : Path_Name_Type; + Canonical_Path_Name : Path_Name_Type; Id : Project_Node_Id; end record; + -- Needs a comment ??? package Project_Stack is new Table.Table (Table_Component_Type => Names_And_Id, @@ -156,7 +156,7 @@ package body Prj.Part is (Context_Clause : With_Id; In_Tree : Project_Node_Tree_Ref; Imported_Projects : out Project_Node_Id; - Project_Directory : Name_Id; + Project_Directory : Path_Name_Type; From_Extended : Extension_Origin; In_Limited : Boolean; Packages_To_Check : String_List_Access); @@ -187,12 +187,13 @@ package body Prj.Part is -- Returns the path name of a project file. Returns an empty string -- if project file cannot be found. - function Immediate_Directory_Of (Path_Name : Name_Id) return Name_Id; + function Immediate_Directory_Of + (Path_Name : Path_Name_Type) return Path_Name_Type; -- Get the directory of the file with the specified path name. -- This includes the directory separator as the last character. -- Returns "./" if Path_Name contains no directory separator. - function Project_Name_From (Path_Name : String) return Name_Id; + function Project_Name_From (Path_Name : String) return File_Name_Type; -- Returns the name of the project that corresponds to its path name. -- Returns No_Name if the path name is invalid, because the corresponding -- project name does not have the syntax of an ada identifier. @@ -215,11 +216,11 @@ package body Prj.Part is Virtual_Name_Id : Name_Id; -- Virtual extending project name id - Virtual_Path_Id : Name_Id; + Virtual_Path_Id : Path_Name_Type; -- Fake path name of the virtual extending project. The directory is -- the same directory as the extending all project. - Virtual_Dir_Id : constant Name_Id := + Virtual_Dir_Id : constant Path_Name_Type := Immediate_Directory_Of (Path_Name_Of (Main_Project, In_Tree)); -- The directory of the extending all project @@ -339,7 +340,7 @@ package body Prj.Part is K => Virtual_Name_Id, E => (Name => Virtual_Name_Id, Node => Virtual_Project, - Canonical_Path => No_Name, + Canonical_Path => No_Path, Extended => False)); end Create_Virtual_Extending_Project; @@ -347,7 +348,9 @@ package body Prj.Part is -- Immediate_Directory_Of -- ---------------------------- - function Immediate_Directory_Of (Path_Name : Name_Id) return Name_Id is + function Immediate_Directory_Of + (Path_Name : Path_Name_Type) return Path_Name_Type + is begin Get_Name_String (Path_Name); @@ -656,7 +659,7 @@ package body Prj.Part is -- Store path and location in table Withs Current_With := - (Path => Token_Name, + (Path => File_Name_Type (Token_Name), Location => Token_Ptr, Limited_With => Limited_With, Node => Current_With_Node, @@ -708,12 +711,12 @@ package body Prj.Part is (Context_Clause : With_Id; In_Tree : Project_Node_Tree_Ref; Imported_Projects : out Project_Node_Id; - Project_Directory : Name_Id; + Project_Directory : Path_Name_Type; From_Extended : Extension_Origin; In_Limited : Boolean; Packages_To_Check : String_List_Access) is - Current_With_Clause : With_Id := Context_Clause; + Current_With_Clause : With_Id; Current_Project : Project_Node_Id := Empty_Node; Previous_Project : Project_Node_Id := Empty_Node; @@ -729,6 +732,7 @@ package body Prj.Part is begin Imported_Projects := Empty_Node; + Current_With_Clause := Context_Clause; while Current_With_Clause /= No_With loop Current_With := Withs.Table (Current_With_Clause); Current_With_Clause := Current_With.Next; @@ -756,8 +760,7 @@ package body Prj.Part is -- The project file cannot be found - Error_Msg_Name_1 := Current_With.Path; - + Error_Msg_File_1 := Current_With.Path; Error_Msg ("unknown project file: {", Current_With.Location); -- If this is not imported by the main project file, @@ -765,7 +768,8 @@ package body Prj.Part is if Project_Stack.Last > 1 then for Index in reverse 1 .. Project_Stack.Last loop - Error_Msg_Name_1 := Project_Stack.Table (Index).Path_Name; + Error_Msg_File_1 := + File_Name_Type (Project_Stack.Table (Index).Path_Name); Error_Msg ("\imported by {", Current_With.Location); end loop; end if; @@ -790,7 +794,7 @@ package body Prj.Part is end if; Set_String_Value_Of - (Current_Project, In_Tree, Current_With.Path); + (Current_Project, In_Tree, Name_Id (Current_With.Path)); Set_Location_Of (Current_Project, In_Tree, Current_With.Location); @@ -800,7 +804,7 @@ package body Prj.Part is if Limited_With and then Project_Stack.Last > 1 then declare - Canonical_Path_Name : Name_Id; + Canonical_Path_Name : Path_Name_Type; begin Name_Len := Resolved_Path'Length; @@ -893,21 +897,22 @@ package body Prj.Part is In_Limited : Boolean; Packages_To_Check : String_List_Access) is - Normed_Path_Name : Name_Id; - Canonical_Path_Name : Name_Id; - Project_Directory : Name_Id; + Normed_Path_Name : Path_Name_Type; + Canonical_Path_Name : Path_Name_Type; + Project_Directory : Path_Name_Type; Project_Scan_State : Saved_Project_Scan_State; Source_Index : Source_File_Index; Extending : Boolean := False; - Extended_Project : Project_Node_Id := Empty_Node; + Extended_Project : Project_Node_Id := Empty_Node; A_Project_Name_And_Node : Tree_Private_Part.Project_Name_And_Node := Tree_Private_Part.Projects_Htable.Get_First (In_Tree.Projects_HT); - Name_From_Path : constant Name_Id := Project_Name_From (Path_Name); + Name_From_Path : constant File_Name_Type := + Project_Name_From (Path_Name); Name_Of_Project : Name_Id := No_Name; @@ -944,20 +949,21 @@ package body Prj.Part is Project_Stack.Table (Index).Canonical_Path_Name then Error_Msg ("circular dependency detected", Token_Ptr); - Error_Msg_Name_1 := Normed_Path_Name; - Error_Msg ("\ { is imported by", Token_Ptr); + Error_Msg_File_1 := File_Name_Type (Normed_Path_Name); + Error_Msg ("\\ { is imported by", Token_Ptr); for Current in reverse 1 .. Project_Stack.Last loop - Error_Msg_Name_1 := Project_Stack.Table (Current).Path_Name; + Error_Msg_File_1 := + File_Name_Type (Project_Stack.Table (Current).Path_Name); if Project_Stack.Table (Current).Canonical_Path_Name /= Canonical_Path_Name then Error_Msg - ("\ { which itself is imported by", Token_Ptr); + ("\\ { which itself is imported by", Token_Ptr); else - Error_Msg ("\ {", Token_Ptr); + Error_Msg ("\\ {", Token_Ptr); exit; end if; end loop; @@ -1054,12 +1060,12 @@ package body Prj.Part is Tree.Reset_State; Scan (In_Tree); - if Name_From_Path = No_Name then + if Name_From_Path = No_File then -- The project file name is not correct (no or bad extension, -- or not following Ada identifier's syntax). - Error_Msg_Name_1 := Canonical_Path_Name; + Error_Msg_File_1 := File_Name_Type (Canonical_Path_Name); Error_Msg ("?{ is not a valid path name for a project file", Token_Ptr); end if; @@ -1172,15 +1178,15 @@ package body Prj.Part is Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); declare - Expected_Name : constant Name_Id := Name_Find; + Expected_Name : constant File_Name_Type := Name_Find; begin -- Output a warning if the actual name is not the expected name - if Name_From_Path /= No_Name + if Name_From_Path /= No_File and then Expected_Name /= Name_From_Path then - Error_Msg_Name_1 := Expected_Name; + Error_Msg_File_1 := Expected_Name; Error_Msg ("?file name does not match unit name, " & "should be `{" & Project_File_Extension & "`", Token_Ptr); @@ -1217,8 +1223,9 @@ package body Prj.Part is declare Name_And_Node : Tree_Private_Part.Project_Name_And_Node := - Tree_Private_Part.Projects_Htable.Get_First - (In_Tree.Projects_HT); + Tree_Private_Part.Projects_Htable.Get_First + (In_Tree.Projects_HT); + Project_Name : Name_Id := Name_And_Node.Name; begin @@ -1238,9 +1245,9 @@ package body Prj.Part is if Project_Name /= No_Name then Error_Msg_Name_1 := Project_Name; Error_Msg - ("duplicate project name {", Location_Of (Project, In_Tree)); - Error_Msg_Name_1 := - Path_Name_Of (Name_And_Node.Node, In_Tree); + ("duplicate project name %%", Location_Of (Project, In_Tree)); + Error_Msg_File_1 := + File_Name_Type (Path_Name_Of (Name_And_Node.Node, In_Tree)); Error_Msg ("\already in {", Location_Of (Project, In_Tree)); @@ -1265,7 +1272,8 @@ package body Prj.Part is Expect (Tok_String_Literal, "literal string"); if Token = Tok_String_Literal then - Set_Extended_Project_Path_Of (Project, In_Tree, Token_Name); + Set_Extended_Project_Path_Of + (Project, In_Tree, Path_Name_Type (Token_Name)); declare Original_Path_Name : constant String := @@ -1282,21 +1290,22 @@ package body Prj.Part is -- We could not find the project file to extend - Error_Msg_Name_1 := Token_Name; - + Error_Msg_File_1 := File_Name_Type (Token_Name); Error_Msg ("unknown project file: {", Token_Ptr); -- If we are not in the main project file, display the -- import path. if Project_Stack.Last > 1 then - Error_Msg_Name_1 := - Project_Stack.Table (Project_Stack.Last).Path_Name; + Error_Msg_File_1 := + File_Name_Type + (Project_Stack.Table (Project_Stack.Last).Path_Name); Error_Msg ("\extended by {", Token_Ptr); for Index in reverse 1 .. Project_Stack.Last - 1 loop - Error_Msg_Name_1 := - Project_Stack.Table (Index).Path_Name; + Error_Msg_File_1 := + File_Name_Type + (Project_Stack.Table (Index).Path_Name); Error_Msg ("\imported by {", Token_Ptr); end loop; end if; @@ -1351,7 +1360,8 @@ package body Prj.Part is Imported := Project_Node_Of (With_Clause, In_Tree); if Is_Extending_All (With_Clause, In_Tree) then - Error_Msg_Name_1 := Name_Of (Imported, In_Tree); + Error_Msg_File_1 := + File_Name_Type (Name_Of (Imported, In_Tree)); Error_Msg ("cannot import extending-all project {", Token_Ptr); exit With_Clause_Loop; @@ -1385,7 +1395,7 @@ package body Prj.Part is Name_Len := Name_Len - 1; declare - Parent_Name : constant Name_Id := Name_Find; + Parent_Name : constant File_Name_Type := Name_Find; Parent_Found : Boolean := False; With_Clause : Project_Node_Id := First_With_Clause_Of (Project, In_Tree); @@ -1395,7 +1405,7 @@ package body Prj.Part is if Extended_Project /= Empty_Node then Parent_Found := - Name_Of (Extended_Project, In_Tree) = Parent_Name; + Name_Of (Extended_Project, In_Tree) = Name_Id (Parent_Name); end if; -- If the parent project is not the extended project, @@ -1404,7 +1414,7 @@ package body Prj.Part is while not Parent_Found and then With_Clause /= Empty_Node loop Parent_Found := Name_Of (Project_Node_Of (With_Clause, In_Tree), In_Tree) = - Parent_Name; + Name_Id (Parent_Name); With_Clause := Next_With_Clause_Of (With_Clause, In_Tree); end loop; @@ -1412,8 +1422,8 @@ package body Prj.Part is if not Parent_Found then Error_Msg_Name_1 := Name_Of_Project; - Error_Msg_Name_2 := Parent_Name; - Error_Msg ("project { does not import or extend project {", + Error_Msg_File_1 := Parent_Name; + Error_Msg ("project %% does not import or extend project {", Location_Of (Project, In_Tree)); end if; end; @@ -1537,7 +1547,7 @@ package body Prj.Part is -- Project_Name_From -- ----------------------- - function Project_Name_From (Path_Name : String) return Name_Id is + function Project_Name_From (Path_Name : String) return File_Name_Type is Canonical : String (1 .. Path_Name'Length) := Path_Name; First : Natural := Canonical'Last; Last : Natural := First; @@ -1553,7 +1563,7 @@ package body Prj.Part is -- If the path name is empty, return No_Name to indicate failure if First = 0 then - return No_Name; + return No_File; end if; Canonical_Case_File_Name (Canonical); @@ -1588,13 +1598,13 @@ package body Prj.Part is else -- Not the correct extension, return No_Name to indicate failure - return No_Name; + return No_File; end if; -- If no dot in the path name, return No_Name to indicate failure else - return No_Name; + return No_File; end if; First := First + 1; @@ -1602,7 +1612,7 @@ package body Prj.Part is -- If the extension is the file name, return No_Name to indicate failure if First > Last then - return No_Name; + return No_File; end if; -- Put the name in lower case into Name_Buffer @@ -1617,7 +1627,7 @@ package body Prj.Part is loop if not Is_Letter (Name_Buffer (Index)) then - return No_Name; + return No_File; else loop @@ -1627,7 +1637,7 @@ package body Prj.Part is if Name_Buffer (Index) = '_' then if Name_Buffer (Index + 1) = '_' then - return No_Name; + return No_File; end if; end if; @@ -1636,7 +1646,7 @@ package body Prj.Part is if Name_Buffer (Index) /= '_' and then not Is_Alphanumeric (Name_Buffer (Index)) then - return No_Name; + return No_File; end if; end loop; @@ -1650,7 +1660,7 @@ package body Prj.Part is return Name_Find; else - return No_Name; + return No_File; end if; elsif Name_Buffer (Index) = '-' then diff --git a/gcc/ada/prj-pp.adb b/gcc/ada/prj-pp.adb index d20e642d7ac..5dd355147f6 100644 --- a/gcc/ada/prj-pp.adb +++ b/gcc/ada/prj-pp.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-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- -- @@ -26,7 +26,6 @@ with Ada.Characters.Handling; use Ada.Characters.Handling; -with Namet; use Namet; with Output; use Output; with Snames; @@ -94,6 +93,7 @@ package body Prj.PP is -- Outputs the indentation at the beginning of the line procedure Output_String (S : Name_Id); + procedure Output_String (S : Path_Name_Type); -- Outputs a string using the default output procedures procedure Write_Empty_Line (Always : Boolean := False); @@ -229,6 +229,11 @@ package body Prj.PP is Column := Column + 1; end Output_String; + procedure Output_String (S : Path_Name_Type) is + begin + Output_String (Name_Id (S)); + end Output_String; + ---------------- -- Start_Line -- ---------------- @@ -335,7 +340,7 @@ package body Prj.PP is -- Check if this project extends another project - if Extended_Project_Path_Of (Node, In_Tree) /= No_Name then + if Extended_Project_Path_Of (Node, In_Tree) /= No_Path then Write_String (" extends "); if Is_Extending_All (Node, In_Tree) then diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index 443a3e80e0c..fe279f9cd1b 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-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- -- @@ -25,7 +25,6 @@ ------------------------------------------------------------------------------ with Err_Vars; use Err_Vars; -with Namet; use Namet; with Opt; use Opt; with Osint; use Osint; with Output; use Output; @@ -142,7 +141,7 @@ package body Prj.Proc is procedure Add (To_Exp : in out Name_Id; Str : Name_Id) is begin - if To_Exp = Types.No_Name or else To_Exp = Empty_String then + if To_Exp = No_Name or else To_Exp = Empty_String then -- To_Exp is nil or empty. The result is Str @@ -568,17 +567,19 @@ package body Prj.Proc is when N_Variable_Reference | N_Attribute_Reference => declare - The_Project : Project_Id := Project; - The_Package : Package_Id := Pkg; - The_Name : Name_Id := No_Name; - The_Variable_Id : Variable_Id := No_Variable; + The_Project : Project_Id := Project; + The_Package : Package_Id := Pkg; + The_Name : Name_Id := No_Name; + The_Variable_Id : Variable_Id := No_Variable; The_Variable : Variable_Value; Term_Project : constant Project_Node_Id := - Project_Node_Of - (The_Current_Term, From_Project_Node_Tree); + Project_Node_Of + (The_Current_Term, + From_Project_Node_Tree); Term_Package : constant Project_Node_Id := - Package_Node_Of - (The_Current_Term, From_Project_Node_Tree); + Package_Node_Of + (The_Current_Term, + From_Project_Node_Tree); Index : Name_Id := No_Name; begin @@ -589,6 +590,7 @@ package body Prj.Proc is The_Name := Name_Of (Term_Project, From_Project_Node_Tree); + The_Project := Imported_Or_Extended_Project_From (Project => Project, In_Tree => In_Tree, @@ -601,6 +603,7 @@ package body Prj.Proc is The_Name := Name_Of (Term_Package, From_Project_Node_Tree); + The_Package := In_Tree.Projects.Table (The_Project).Decl.Packages; @@ -1139,7 +1142,7 @@ package body Prj.Proc is Follow_Links : Boolean := True; When_No_Sources : Error_Warning := Error) is - Obj_Dir : Name_Id; + Obj_Dir : Path_Name_Type; Extending : Project_Id; Extending2 : Project_Id; @@ -1174,7 +1177,7 @@ package body Prj.Proc is and then Is_Extending_All (From_Project_Node, From_Project_Node_Tree) then declare - Object_Dir : constant Name_Id := + Object_Dir : constant Path_Name_Type := In_Tree.Projects.Table (Project).Object_Directory; begin for Index in @@ -1219,7 +1222,7 @@ package body Prj.Proc is if Error_Report = null then Error_Msg - ("project { cannot be extended by a virtual " & + ("project % cannot be extended by a virtual " & "project with the same object directory", In_Tree.Projects.Table (Proj).Location); else @@ -1239,7 +1242,7 @@ package body Prj.Proc is if Error_Report = null then Error_Msg - ("project { cannot extend project {", + ("project %% cannot extend project %%", In_Tree.Projects.Table (Extending2).Location); Error_Msg ("\they share the same object directory", @@ -1436,7 +1439,9 @@ package body Prj.Proc is declare Current_Item_Name : constant Name_Id := - Name_Of (Current_Item, From_Project_Node_Tree); + Name_Of + (Current_Item, + From_Project_Node_Tree); -- The name of the attribute New_Array : Array_Id; @@ -1529,10 +1534,10 @@ package body Prj.Proc is -- Find the project where the value is declared Orig_Project_Name := - Name_Of - (Associative_Project_Of - (Current_Item, From_Project_Node_Tree), - From_Project_Node_Tree); + Name_Of + (Associative_Project_Of + (Current_Item, From_Project_Node_Tree), + From_Project_Node_Tree); for Index in Project_Table.First .. Project_Table.Last @@ -1786,7 +1791,8 @@ package body Prj.Proc is if Error_Report = null then Error_Msg - ("value { is illegal for typed string %", + ("value %% is illegal for " + & "typed string %", Location_Of (Current_Item, From_Project_Node_Tree)); @@ -1799,6 +1805,10 @@ package body Prj.Proc is Get_Name_String (Error_Msg_Name_2) & """", Project, In_Tree); + -- Calls like this to Error_Report are + -- wrong, since they don't properly case + -- and decode names corresponding to the + -- ordinary case of % insertion ??? end if; end if; end; @@ -2404,7 +2414,8 @@ package body Prj.Proc is Location_Of (From_Project_Node, From_Project_Node_Tree); Processed_Data.Display_Directory := - Directory_Of (From_Project_Node, From_Project_Node_Tree); + Path_Name_Type + (Directory_Of (From_Project_Node, From_Project_Node_Tree)); Get_Name_String (Processed_Data.Display_Directory); Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); Processed_Data.Directory := Name_Find; diff --git a/gcc/ada/prj-tree.adb b/gcc/ada/prj-tree.adb index 3bd65344022..e2f7f2d160c 100644 --- a/gcc/ada/prj-tree.adb +++ b/gcc/ada/prj-tree.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-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- -- @@ -111,13 +111,13 @@ package body Prj.Tree is (Kind => N_Comment_Zones, Expr_Kind => Undefined, Location => No_Location, - Directory => No_Name, + Directory => No_Path, Variables => Empty_Node, Packages => Empty_Node, Pkg_Id => Empty_Package, Name => No_Name, Src_Index => 0, - Path_Name => No_Name, + Path_Name => No_Path, Value => No_Name, Field1 => Empty_Node, Field2 => Empty_Node, @@ -159,13 +159,13 @@ package body Prj.Tree is Flag2 => Comments.Table (J).Is_Followed_By_Empty_Line, Location => No_Location, - Directory => No_Name, + Directory => No_Path, Variables => Empty_Node, Packages => Empty_Node, Pkg_Id => Empty_Package, Name => No_Name, Src_Index => 0, - Path_Name => No_Name, + Path_Name => No_Path, Value => Comments.Table (J).Value, Field1 => Empty_Node, Field2 => Empty_Node, @@ -323,14 +323,14 @@ package body Prj.Tree is In_Tree.Project_Nodes.Table (Zone) := (Kind => N_Comment_Zones, Location => No_Location, - Directory => No_Name, + Directory => No_Path, Expr_Kind => Undefined, Variables => Empty_Node, Packages => Empty_Node, Pkg_Id => Empty_Package, Name => No_Name, Src_Index => 0, - Path_Name => No_Name, + Path_Name => No_Path, Value => No_Name, Field1 => Empty_Node, Field2 => Empty_Node, @@ -397,14 +397,14 @@ package body Prj.Tree is (Project_Node_Table.Last (In_Tree.Project_Nodes)) := (Kind => Of_Kind, Location => No_Location, - Directory => No_Name, + Directory => No_Path, Expr_Kind => And_Expr_Kind, Variables => Empty_Node, Packages => Empty_Node, Pkg_Id => Empty_Package, Name => No_Name, Src_Index => 0, - Path_Name => No_Name, + Path_Name => No_Path, Value => No_Name, Field1 => Empty_Node, Field2 => Empty_Node, @@ -432,13 +432,13 @@ package body Prj.Tree is (Kind => N_Comment_Zones, Expr_Kind => Undefined, Location => No_Location, - Directory => No_Name, + Directory => No_Path, Variables => Empty_Node, Packages => Empty_Node, Pkg_Id => Empty_Package, Name => No_Name, Src_Index => 0, - Path_Name => No_Name, + Path_Name => No_Path, Value => No_Name, Field1 => Empty_Node, Field2 => Empty_Node, @@ -464,13 +464,13 @@ package body Prj.Tree is Flag2 => Comments.Table (J).Is_Followed_By_Empty_Line, Location => No_Location, - Directory => No_Name, + Directory => No_Path, Variables => Empty_Node, Packages => Empty_Node, Pkg_Id => Empty_Package, Name => No_Name, Src_Index => 0, - Path_Name => No_Name, + Path_Name => No_Path, Value => Comments.Table (J).Value, Field1 => Empty_Node, Field2 => Empty_Node, @@ -510,7 +510,7 @@ package body Prj.Tree is function Directory_Of (Node : Project_Node_Id; - In_Tree : Project_Node_Tree_Ref) return Name_Id is + In_Tree : Project_Node_Tree_Ref) return Path_Name_Type is begin pragma Assert (Node /= Empty_Node @@ -619,14 +619,14 @@ package body Prj.Tree is function Extended_Project_Path_Of (Node : Project_Node_Id; - In_Tree : Project_Node_Tree_Ref) return Name_Id + In_Tree : Project_Node_Tree_Ref) return Path_Name_Type is begin pragma Assert (Node /= Empty_Node and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project); - return In_Tree.Project_Nodes.Table (Node).Value; + return Path_Name_Type (In_Tree.Project_Nodes.Table (Node).Value); end Extended_Project_Path_Of; -------------------------- @@ -1325,7 +1325,7 @@ package body Prj.Tree is function Path_Name_Of (Node : Project_Node_Id; - In_Tree : Project_Node_Tree_Ref) return Name_Id + In_Tree : Project_Node_Tree_Ref) return Path_Name_Type is begin pragma Assert @@ -1716,7 +1716,7 @@ package body Prj.Tree is procedure Set_Directory_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; - To : Name_Id) + To : Path_Name_Type) is begin pragma Assert @@ -2187,14 +2187,14 @@ package body Prj.Tree is procedure Set_Extended_Project_Path_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; - To : Name_Id) + To : Path_Name_Type) is begin pragma Assert (Node /= Empty_Node and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project); - In_Tree.Project_Nodes.Table (Node).Value := To; + In_Tree.Project_Nodes.Table (Node).Value := Name_Id (To); end Set_Extended_Project_Path_Of; ------------------------------ @@ -2422,7 +2422,7 @@ package body Prj.Tree is procedure Set_Path_Name_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; - To : Name_Id) + To : Path_Name_Type) is begin pragma Assert diff --git a/gcc/ada/prj-tree.ads b/gcc/ada/prj-tree.ads index c3bdfd0665c..470e0a8e84a 100644 --- a/gcc/ada/prj-tree.ads +++ b/gcc/ada/prj-tree.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-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- -- @@ -266,7 +266,7 @@ package Prj.Tree is function Directory_Of (Node : Project_Node_Id; - In_Tree : Project_Node_Tree_Ref) return Name_Id; + In_Tree : Project_Node_Tree_Ref) return Path_Name_Type; pragma Inline (Directory_Of); -- Only valid for N_Project nodes @@ -310,7 +310,7 @@ package Prj.Tree is function Path_Name_Of (Node : Project_Node_Id; - In_Tree : Project_Node_Tree_Ref) return Name_Id; + In_Tree : Project_Node_Tree_Ref) return Path_Name_Type; pragma Inline (Path_Name_Of); -- Only valid for N_Project and N_With_Clause nodes @@ -354,7 +354,7 @@ package Prj.Tree is function Extended_Project_Path_Of (Node : Project_Node_Id; - In_Tree : Project_Node_Tree_Ref) return Name_Id; + In_Tree : Project_Node_Tree_Ref) return Path_Name_Type; pragma Inline (Extended_Project_Path_Of); -- Only valid for N_With_Clause nodes @@ -629,7 +629,7 @@ package Prj.Tree is procedure Set_Directory_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; - To : Name_Id); + To : Path_Name_Type); pragma Inline (Set_Directory_Of); procedure Set_Expression_Kind_Of @@ -669,7 +669,7 @@ package Prj.Tree is procedure Set_Path_Name_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; - To : Name_Id); + To : Path_Name_Type); pragma Inline (Set_Path_Name_Of); procedure Set_String_Value_Of @@ -705,7 +705,7 @@ package Prj.Tree is procedure Set_Extended_Project_Path_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; - To : Name_Id); + To : Path_Name_Type); pragma Inline (Set_Extended_Project_Path_Of); procedure Set_Project_Node_Of @@ -900,8 +900,9 @@ package Prj.Tree is package Tree_Private_Part is - -- This is conceptually in the private part. - -- However, for efficiency, some packages are accessing it directly. + -- This is conceptually in the private part + + -- However, for efficiency, some packages are accessing it directly type Project_Node_Record is record @@ -909,7 +910,7 @@ package Prj.Tree is Location : Source_Ptr := No_Location; - Directory : Name_Id := No_Name; + Directory : Path_Name_Type := No_Path; -- Only for N_Project Expr_Kind : Variable_Kind := Undefined; @@ -938,7 +939,7 @@ package Prj.Tree is -- Index of a unit in a multi-unit source. -- Onli for some N_Attribute_Declaration and N_Literal_String. - Path_Name : Name_Id := No_Name; + Path_Name : Path_Name_Type := No_Path; -- See below for what Project_Node_Kind it is used Value : Name_Id := No_Name; @@ -1204,7 +1205,7 @@ package Prj.Tree is Node : Project_Node_Id; -- Node of the project in table Project_Nodes - Canonical_Path : Name_Id; + Canonical_Path : Path_Name_Type; -- Resolved and canonical path of the project file Extended : Boolean; @@ -1214,7 +1215,7 @@ package Prj.Tree is No_Project_Name_And_Node : constant Project_Name_And_Node := (Name => No_Name, Node => Empty_Node, - Canonical_Path => No_Name, + Canonical_Path => No_Path, Extended => True); package Projects_Htable is new GNAT.Dynamic_HTables.Simple_HTable @@ -1226,9 +1227,8 @@ package Prj.Tree is Equal => "="); -- This hash table contains a mapping of project names to project nodes. -- Note that this hash table contains only the nodes whose Kind is - -- N_Project. It is used to find the node of a project from its - -- name, and to verify if a project has already been parsed, knowing - -- its name. + -- N_Project. It is used to find the node of a project from its name, + -- and to verify if a project has already been parsed, knowing its name. end Tree_Private_Part; diff --git a/gcc/ada/prj-util.adb b/gcc/ada/prj-util.adb index 845b546ee8b..4c00ac49a13 100644 --- a/gcc/ada/prj-util.adb +++ b/gcc/ada/prj-util.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-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- -- @@ -26,9 +26,8 @@ with Ada.Unchecked_Deallocation; -with GNAT.Case_Util; use GNAT.Case_Util; +with System.Case_Util; use System.Case_Util; -with Namet; use Namet; with Osint; use Osint; with Output; use Output; with Prj.Com; @@ -77,9 +76,9 @@ package body Prj.Util is function Executable_Of (Project : Project_Id; In_Tree : Project_Tree_Ref; - Main : Name_Id; + Main : File_Name_Type; Index : Int; - Ada_Main : Boolean := True) return Name_Id + Ada_Main : Boolean := True) return File_Name_Type is pragma Assert (Project /= No_Project); @@ -94,7 +93,7 @@ package body Prj.Util is Executable : Variable_Value := Prj.Util.Value_Of - (Name => Main, + (Name => Name_Id (Main), Index => Index, Attribute_Or_Array_Name => Name_Executable, In_Package => Builder_Package, @@ -184,7 +183,7 @@ package body Prj.Util is declare Saved_EEOT : constant Name_Id := Executable_Extension_On_Target; - Result : Name_Id; + Result : File_Name_Type; begin if Executable_Suffix /= Nil_Variable_Value @@ -193,7 +192,7 @@ package body Prj.Util is Executable_Extension_On_Target := Executable_Suffix.Value; end if; - Result := Executable_Name (Executable.Value); + Result := Executable_Name (File_Name_Type (Executable.Value)); Executable_Extension_On_Target := Saved_EEOT; return Result; end; @@ -348,7 +347,7 @@ package body Prj.Util is File_Name (1 .. Name'Length) := Name; File_Name (File_Name'Last) := ASCII.NUL; FD := Open_Read (Name => File_Name'Address, - Fmode => GNAT.OS_Lib.Text); + Fmode => GNAT.OS_Lib.Text); if FD = Invalid_FD then File := null; else diff --git a/gcc/ada/prj-util.ads b/gcc/ada/prj-util.ads index 5d77678af89..4163f98b2c8 100644 --- a/gcc/ada/prj-util.ads +++ b/gcc/ada/prj-util.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-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- -- @@ -31,9 +31,9 @@ package Prj.Util is function Executable_Of (Project : Project_Id; In_Tree : Project_Tree_Ref; - Main : Name_Id; + Main : File_Name_Type; Index : Int; - Ada_Main : Boolean := True) return Name_Id; + Ada_Main : Boolean := True) return File_Name_Type; -- Return the value of the attribute Builder'Executable for file Main in -- the project Project, if it exists. If there is no attribute Executable -- for Main, remove the suffix from Main; then, if the attribute @@ -62,9 +62,8 @@ package Prj.Util is Src_Index : Int := 0; In_Array : Array_Element_Id; In_Tree : Project_Tree_Ref) return Variable_Value; - -- Get a string array component (single String or String list). - -- Returns Nil_Variable_Value if there is no component Index - -- or if In_Array is null. + -- Get a string array component (single String or String list). Returns + -- Nil_Variable_Value if no component Index or if In_Array is null. -- -- Depending on the attribute (only attributes may be associative arrays) -- the index may or may not be case sensitive. If the index is not case diff --git a/gcc/ada/scans.adb b/gcc/ada/scans.adb index a22fdfd99d0..4422064b28f 100644 --- a/gcc/ada/scans.adb +++ b/gcc/ada/scans.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- -- @@ -31,7 +31,6 @@ -- -- ------------------------------------------------------------------------------ -with Namet; use Namet; with Snames; use Snames; package body Scans is diff --git a/gcc/ada/scans.ads b/gcc/ada/scans.ads index a01b9570e22..c838865b477 100644 --- a/gcc/ada/scans.ads +++ b/gcc/ada/scans.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- 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- -- @@ -31,6 +31,7 @@ -- -- ------------------------------------------------------------------------------ +with Namet; use Namet; with Types; use Types; with Uintp; use Uintp; with Urealp; use Urealp; diff --git a/gcc/ada/sem_ch2.adb b/gcc/ada/sem_ch2.adb index b2e82b133df..a4de99e73a0 100644 --- a/gcc/ada/sem_ch2.adb +++ b/gcc/ada/sem_ch2.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2005, 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- -- @@ -26,6 +26,7 @@ with Atree; use Atree; with Errout; use Errout; +with Namet; use Namet; with Opt; use Opt; with Restrict; use Restrict; with Rident; use Rident; diff --git a/gcc/ada/sinput-c.adb b/gcc/ada/sinput-c.adb index f762602778e..d2886946fd8 100644 --- a/gcc/ada/sinput-c.adb +++ b/gcc/ada/sinput-c.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- -- @@ -24,13 +24,12 @@ -- -- ------------------------------------------------------------------------------ -with Namet; use Namet; with Opt; use Opt; with System; use System; with Ada.Unchecked_Conversion; -with GNAT.OS_Lib; use GNAT.OS_Lib; +with System.OS_Lib; use System.OS_Lib; package body Sinput.C is @@ -53,8 +52,8 @@ package body Sinput.C is Actual_Len : Integer; - Path_Id : Name_Id; - File_Id : Name_Id; + Path_Id : File_Name_Type; + File_Id : File_Name_Type; begin if Path = "" then diff --git a/gcc/ada/styleg-c.adb b/gcc/ada/styleg-c.adb index fa3690ea427..44bced22dab 100644 --- a/gcc/ada/styleg-c.adb +++ b/gcc/ada/styleg-c.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- -- @@ -227,7 +227,7 @@ package body Styleg.C is Set_Casing (Cas); Error_Msg_Name_1 := Name_Enter; Error_Msg_N - ("(style) bad casing of { declared in Standard", Ref); + ("(style) bad casing of %% declared in Standard", Ref); end if; end if; end if; diff --git a/gcc/ada/tempdir.adb b/gcc/ada/tempdir.adb index a0b8adacac7..7044271532f 100644 --- a/gcc/ada/tempdir.adb +++ b/gcc/ada/tempdir.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2003-2005 Free Software Foundation, Inc. -- +-- Copyright (C) 2003-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- -- @@ -26,7 +26,6 @@ with GNAT.Directory_Operations; use GNAT.Directory_Operations; -with Namet; use Namet; with Opt; use Opt; with Output; use Output; @@ -38,9 +37,13 @@ package body Tempdir is No_Dir : aliased String := ""; Temp_Dir : String_Access := No_Dir'Access; + ---------------------- + -- Create_Temp_File -- + ---------------------- + procedure Create_Temp_File (FD : out File_Descriptor; - Name : out Name_Id) + Name : out Path_Name_Type) is File_Name : String_Access; Current_Dir : constant String := Get_Current_Dir; @@ -90,13 +93,13 @@ package body Tempdir is end if; if FD = Invalid_FD then - Name := No_Name; + Name := No_Path; else declare Path_Name : constant String := - Normalize_Pathname - (Directory & Directory_Separator & File_Name.all); + Normalize_Pathname + (Directory & Directory_Separator & File_Name.all); begin Name_Len := Path_Name'Length; diff --git a/gcc/ada/tempdir.ads b/gcc/ada/tempdir.ads index 6416f3d7038..82c735a1b93 100644 --- a/gcc/ada/tempdir.ads +++ b/gcc/ada/tempdir.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2003 Free Software Foundation, Inc. -- +-- Copyright (C) 2003-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- -- @@ -29,14 +29,15 @@ -- designates an absolute path, temporary files are create in this directory. -- Otherwise, temporary files are created in the current working directory. -with GNAT.OS_Lib; use GNAT.OS_Lib; -with Types; use Types; +with Namet; use Namet; + +with System.OS_Lib; use System.OS_Lib; package Tempdir is procedure Create_Temp_File (FD : out File_Descriptor; - Name : out Name_Id); + Name : out Path_Name_Type); -- Create a temporary text file and return its file descriptor and -- its path name as a Name_Id. If environment variable TMPDIR is defined -- and its value is an absolute path, the temp file is created in the diff --git a/gcc/ada/uname.adb b/gcc/ada/uname.adb index ee000d48fe6..f0873229a55 100644 --- a/gcc/ada/uname.adb +++ b/gcc/ada/uname.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2005, 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- -- @@ -36,7 +36,6 @@ with Casing; use Casing; with Einfo; use Einfo; with Hostparm; with Lib; use Lib; -with Namet; use Namet; with Nlists; use Nlists; with Output; use Output; with Sinfo; use Sinfo; @@ -138,7 +137,7 @@ package body Uname is while Name_Buffer (Name_Len) /= '.' loop if Name_Len = 1 then - return No_Name; -- not a child or subunit name + return No_Unit_Name; else Name_Len := Name_Len - 1; end if; @@ -425,7 +424,10 @@ package body Uname is -- Get_Unit_Name_String -- -------------------------- - procedure Get_Unit_Name_String (N : Unit_Name_Type) is + procedure Get_Unit_Name_String + (N : Unit_Name_Type; + Suffix : Boolean := True) + is Unit_Is_Body : Boolean; begin @@ -447,10 +449,12 @@ package body Uname is -- Now adjust the %s or %b to (spec) or (body) - if Unit_Is_Body then - Name_Buffer (Name_Len - 1 .. Name_Len + 5) := " (body)"; - else - Name_Buffer (Name_Len - 1 .. Name_Len + 5) := " (spec)"; + if Suffix then + if Unit_Is_Body then + Name_Buffer (Name_Len - 1 .. Name_Len + 5) := " (body)"; + else + Name_Buffer (Name_Len - 1 .. Name_Len + 5) := " (spec)"; + end if; end if; for J in 1 .. Name_Len loop @@ -459,7 +463,13 @@ package body Uname is end if; end loop; - Name_Len := Name_Len + (7 - 2); + -- Adjust Name_Len + + if Suffix then + Name_Len := Name_Len + (7 - 2); + else + Name_Len := Name_Len - 2; + end if; end Get_Unit_Name_String; ------------------ diff --git a/gcc/ada/uname.ads b/gcc/ada/uname.ads index bf2ed3ab99a..adbbf42b1f0 100644 --- a/gcc/ada/uname.ads +++ b/gcc/ada/uname.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2005, 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- -- @@ -31,7 +31,9 @@ -- -- ------------------------------------------------------------------------------ +with Namet; use Namet; with Types; use Types; + package Uname is --------------------------- @@ -116,11 +118,14 @@ package Uname is -- N_Protected_Body_Stub -- N_Subunit - procedure Get_Unit_Name_String (N : Unit_Name_Type); - -- Places the display name of the unit in Name_Buffer and sets Name_Len - -- to the length of the stored name, i.e. it uses the same interface as - -- the Get_Name_String routine in the Namet package. The name contains - -- an indication of spec or body, and is decoded. + procedure Get_Unit_Name_String + (N : Unit_Name_Type; + Suffix : Boolean := True); + -- Places the display name of the unit in Name_Buffer and sets Name_Len to + -- the length of the stored name, i.e. it uses the same interface as the + -- Get_Name_String routine in the Namet package. The name is decoded and + -- contains an indication of spec or body if Boolean parameter Suffix is + -- True. function Is_Body_Name (N : Unit_Name_Type) return Boolean; -- Returns True iff the given name is the unit name of a body (i.e. if |