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

1 files changed, 107 insertions, 42 deletions

diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb
index b987636ac7b..1b077c53bd3 100644
--- a/gcc/ada/ali.adb
+++ b/gcc/ada/ali.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -27,7 +27,6 @@
 with Butil;  use Butil;
 with Debug;  use Debug;
 with Fname;  use Fname;
-with Namet;  use Namet;
 with Opt;    use Opt;
 with Osint;  use Osint;
 with Output; use Output;
@@ -179,19 +178,37 @@ package body ALI is
       function Getc return Character;
       --  Get next character, bumping P past the character obtained
 
+      function Get_File_Name (Lower : Boolean := False) return File_Name_Type;
+      --  Skip blanks, then scan out a file name (name is left in Name_Buffer
+      --  with length in Name_Len, as well as returning a File_Name_Type value.
+      --  If lower is false, the case is unchanged, if Lower is True then the
+      --  result is forced to all lower case for systems where file names are
+      --  not case sensitive. This ensures that gnatbind works correctly
+      --  regardless of the case of the file name on all systems. The scan
+      --  is terminated by a end of line, space or horizontal tab. Any other
+      --  special characters are included in the returned name.
+
       function Get_Name
-        (Lower         : Boolean := False;
-         Ignore_Spaces : Boolean := False) return Name_Id;
+        (Ignore_Spaces  : Boolean := False;
+         Ignore_Special : Boolean := False)return Name_Id;
       --  Skip blanks, then scan out a name (name is left in Name_Buffer with
       --  length in Name_Len, as well as being returned in Name_Id form).
       --  If Lower is set to True then the Name_Buffer will be converted to
       --  all lower case, for systems where file names are not case sensitive.
       --  This ensures that gnatbind works correctly regardless of the case
-      --  of the file name on all systems. The name is terminated by a either
-      --  white space (when Ignore_Spaces is False) or a typeref bracket or
-      --  an equal sign except for the special case of an operator name
-      --  starting with a double quite which is terminated by another double
-      --  quote. This function handles wide characters properly.
+      --  of the file name on all systems. The termination condition depends
+      --  on the settings of Ignore_Spaces and Ignore_Special:
+      --
+      --    If Ignore_Spaces is False (normal case), then scan is terminated
+      --    by the normal end of field condition (EOL, space, horizontal tab)
+      --
+      --    If Ignore_Special is False (normal case), the scan is terminated by
+      --    a typeref bracket or an equal sign except for the special case of
+      --    an operator name starting with a double quite which is terminated
+      --    by another double quote.
+      --
+      --  It is an error to set both Ignore_Spaces and Ignore_Special to True.
+      --  This function handles wide characters properly.
 
       function Get_Nat return Nat;
       --  Skip blanks, then scan out an unsigned integer value in Nat range
@@ -200,6 +217,11 @@ package body ALI is
       function Get_Stamp return Time_Stamp_Type;
       --  Skip blanks, then scan out a time stamp
 
+      function Get_Unit_Name return Unit_Name_Type;
+      --  Skip blanks, then scan out a file name (name is left in Name_Buffer
+      --  with length in Name_Len, as well as returning a Unit_Name_Type value.
+      --  The case is unchanged and terminated by a normal end of field.
+
       function Nextc return Character;
       --  Return current character without modifying pointer P
 
@@ -341,8 +363,14 @@ package body ALI is
          Write_Name (F);
          Write_Str (" is incorrectly formatted");
          Write_Eol;
-         Write_Str
-           ("make sure you are using consistent versions of gcc/gnatbind");
+
+         Write_Str ("make sure you are using consistent versions " &
+
+         --  Split the following line so that it can easily be transformed for
+         --  e.g. JVM/.NET back-ends where the compiler has a different name.
+
+                    "of gcc/gnatbind");
+
          Write_Eol;
 
          --  Find start of line
@@ -409,13 +437,37 @@ package body ALI is
          end if;
       end Fatal_Error_Ignore;
 
+      -------------------
+      -- Get_File_Name --
+      -------------------
+
+      function Get_File_Name
+        (Lower : Boolean := False) return File_Name_Type
+      is
+         F : Name_Id;
+
+      begin
+         F := Get_Name (Ignore_Special => True);
+
+         --  Convert file name to all lower case if file names are not case
+         --  sensitive. This ensures that we handle names in the canonical
+         --  lower case format, regardless of the actual case.
+
+         if Lower and not File_Names_Case_Sensitive then
+            Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+            return Name_Find;
+         else
+            return File_Name_Type (F);
+         end if;
+      end Get_File_Name;
+
       --------------
       -- Get_Name --
       --------------
 
       function Get_Name
-        (Lower         : Boolean := False;
-         Ignore_Spaces : Boolean := False) return Name_Id
+        (Ignore_Spaces  : Boolean := False;
+         Ignore_Special : Boolean := False) return Name_Id
       is
       begin
          Name_Len := 0;
@@ -435,39 +487,42 @@ package body ALI is
 
             exit when At_End_Of_Field and not Ignore_Spaces;
 
-            if Name_Buffer (1) = '"' then
-               exit when Name_Len > 1 and then Name_Buffer (Name_Len) = '"';
+            if not Ignore_Special then
+               if Name_Buffer (1) = '"' then
+                  exit when Name_Len > 1 and then Name_Buffer (Name_Len) = '"';
 
-            else
-               --  Terminate on parens or angle brackets or equal sign
+               else
+                  --  Terminate on parens or angle brackets or equal sign
 
-               exit when Nextc = '(' or else Nextc = ')'
-                 or else Nextc = '{' or else Nextc = '}'
-                 or else Nextc = '<' or else Nextc = '>'
-                 or else Nextc = '=';
+                  exit when Nextc = '(' or else Nextc = ')'
+                    or else Nextc = '{' or else Nextc = '}'
+                    or else Nextc = '<' or else Nextc = '>'
+                    or else Nextc = '=';
 
-               --  Terminate if left bracket not part of wide char sequence
-               --  Note that we only recognize brackets notation so far ???
+                  --  Terminate if left bracket not part of wide char sequence
+                  --  Note that we only recognize brackets notation so far ???
 
-               exit when Nextc = '[' and then T (P + 1) /= '"';
+                  exit when Nextc = '[' and then T (P + 1) /= '"';
 
-               --  Terminate if right bracket not part of wide char sequence
+                  --  Terminate if right bracket not part of wide char sequence
 
-               exit when Nextc = ']' and then T (P - 1) /= '"';
+                  exit when Nextc = ']' and then T (P - 1) /= '"';
+               end if;
             end if;
          end loop;
 
-         --  Convert file name to all lower case if file names are not case
-         --  sensitive. This ensures that we handle names in the canonical
-         --  lower case format, regardless of the actual case.
-
-         if Lower and not File_Names_Case_Sensitive then
-            Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
-         end if;
-
          return Name_Find;
       end Get_Name;
 
+      -------------------
+      -- Get_Unit_Name --
+      -------------------
+
+      function Get_Unit_Name return Unit_Name_Type is
+      begin
+         return Unit_Name_Type (Get_Name);
+      end Get_Unit_Name;
+
       -------------
       -- Get_Nat --
       -------------
@@ -767,7 +822,7 @@ package body ALI is
         Queuing_Policy             => ' ',
         Restrictions               => No_Restrictions,
         SAL_Interface              => False,
-        Sfile                      => No_Name,
+        Sfile                      => No_File,
         Task_Dispatching_Policy    => ' ',
         Time_Slice_Value           => -1,
         WC_Encoding                => '8',
@@ -1328,11 +1383,11 @@ package body ALI is
             UL : Unit_Record renames Units.Table (Units.Last);
 
          begin
-            UL.Uname                    := Get_Name;
+            UL.Uname                    := Get_Unit_Name;
             UL.Predefined               := Is_Predefined_Unit;
             UL.Internal                 := Is_Internal_Unit;
             UL.My_ALI                   := Id;
-            UL.Sfile                    := Get_Name (Lower => True);
+            UL.Sfile                    := Get_File_Name (Lower => True);
             UL.Pure                     := False;
             UL.Preelab                  := False;
             UL.No_Elab                  := False;
@@ -1617,7 +1672,7 @@ package body ALI is
                Checkc (' ');
                Skip_Space;
                Withs.Increment_Last;
-               Withs.Table (Withs.Last).Uname              := Get_Name;
+               Withs.Table (Withs.Last).Uname              := Get_Unit_Name;
                Withs.Table (Withs.Last).Elaborate          := False;
                Withs.Table (Withs.Last).Elaborate_All      := False;
                Withs.Table (Withs.Last).Elab_Desirable     := False;
@@ -1633,8 +1688,10 @@ package body ALI is
                --  Normal case
 
                else
-                  Withs.Table (Withs.Last).Sfile := Get_Name (Lower => True);
-                  Withs.Table (Withs.Last).Afile := Get_Name;
+                  Withs.Table (Withs.Last).Sfile := Get_File_Name
+                                                      (Lower => True);
+                  Withs.Table (Withs.Last).Afile := Get_File_Name
+                                                      (Lower => True);
 
                   --  Scan out possible E, EA, ED, and AD parameters
 
@@ -1675,6 +1732,9 @@ package body ALI is
                                 True;
                            end if;
                         end if;
+
+                     else
+                        Fatal_Error;
                      end if;
                   end loop;
                end if;
@@ -1852,7 +1912,12 @@ package body ALI is
             Checkc (' ');
             Skip_Space;
             Sdep.Increment_Last;
-            Sdep.Table (Sdep.Last).Sfile := Get_Name (Lower => True);
+
+            --  In the following call, Lower is not set to True, this is either
+            --  a bug, or it deserves a special comment as to why this is so???
+
+            Sdep.Table (Sdep.Last).Sfile := Get_File_Name;
+
             Sdep.Table (Sdep.Last).Stamp := Get_Stamp;
             Sdep.Table (Sdep.Last).Dummy_Entry :=
               (Sdep.Table (Sdep.Last).Stamp = Dummy_Time_Stamp);
@@ -1982,7 +2047,7 @@ package body ALI is
 
          begin
             XS.File_Num     := Sdep_Id (Get_Nat + Nat (First_Sdep_Entry) - 1);
-            XS.File_Name    := Get_Name;
+            XS.File_Name    := Get_File_Name;
             XS.First_Entity := Xref_Entity.Last + 1;
 
             Current_File_Num := XS.File_Num;