prj-nmsc.adb (Check_Ada_Name): For children of package A...

2006-10-31  Vincent Celier  <celier@adacore.com>

	* prj-nmsc.adb (Check_Ada_Name): For children of package A, G, I and S
	on VMS, change "__" to '.' before checking the name.
	(Record_Ada_Source): Always add the source file name in the list of
	of sources, even if it is not the first time, as it is for another
	source index.
	(Get_Unit): Replace both '_' (after 'a', 'g', 'i' or 's') with a single
	dot, instead of replacing only the first '_'.

	* prj-part.adb (Parse): Convert project file path to canonical form

	* prj-proc.adb (Recursive_Process): Make sure that, when a project is
	extended, the project id of the project extending it is recorded in its
	data, even when it has already been processed as an imported project.

From-SVN: r118293

gcc/ada/prj-nmsc.adb

@@ -505,6 +505,20 @@ package body Prj.Nmsc is
 
       Name_Len := The_Name'Length;
       Name_Buffer (1 .. Name_Len) := The_Name;
+
+      --  Special cases of children of packages A, G, I and S on VMS
+
+      if OpenVMS_On_Target and then
+        Name_Len > 3 and then
+        Name_Buffer (2 .. 3) = "__" and then
+        ((Name_Buffer (1) = 'a') or else (Name_Buffer (1) = 'g') or else
+         (Name_Buffer (1) = 'i') or else (Name_Buffer (1) = 's'))
+      then
+         Name_Buffer (2) := '.';
+         Name_Buffer (3 .. Name_Len - 1) := Name_Buffer (4 .. Name_Len);
+         Name_Len := Name_Len - 1;
+      end if;
+
       Real_Name := Name_Find;
 
       --  Check first that the given name is not an Ada reserved word
@@ -3878,7 +3892,8 @@ package body Prj.Nmsc is
          --  Check if the casing is right
 
          declare
-            Src : String := File (First .. Last);
+            Src      : String := File (First .. Last);
+            Src_Last : Positive := Last;
 
          begin
             case Naming.Casing is
@@ -3921,38 +3936,49 @@ package body Prj.Nmsc is
                   S3 : constant Character := Src (Src'First + 2);
 
                begin
-                  if S1 = 'a' or else S1 = 'g'
-                    or else S1 = 'i' or else S1 = 's'
+                  if S1 = 'a' or else
+                     S1 = 'g' or else
+                     S1 = 'i' or else
+                     S1 = 's'
                   then
-                     --  Children or separates of packages A, G, I or S
+                     --  Children or separates of packages A, G, I or S. On
+                     --  VMS these names are x__ ... and on other systems the
+                     --  names are x~... (where x is a, g, i, or s).
 
                      if (OpenVMS_On_Target
-                         and then S2 = '_'
-                         and then S3 = '_')
-                        or else
-                         S2 = '~'
+                          and then S2 = '_'
+                          and then S3 = '_')
+                       or else
+                         (not OpenVMS_On_Target
+                           and then S2 = '~')
                      then
                         Src (Src'First + 1) := '.';
 
+                        if OpenVMS_On_Target then
+                           Src_Last := Src_Last - 1;
+                           Src (Src'First + 2 .. Src_Last) :=
+                             Src (Src'First + 3 .. Src_Last + 1);
+                        end if;
+
                      --  If it is potentially a run time source, disable
                      --  filling of the mapping file to avoid warnings.
 
                      elsif S2 = '.' then
                         Set_Mapping_File_Initial_State_To_Empty;
                      end if;
-
                   end if;
                end;
             end if;
 
             if Current_Verbosity = High then
                Write_Str  ("      ");
-               Write_Line (Src);
+               Write_Line (Src (Src'First .. Src_Last));
             end if;
 
             --  Now, we check if this name is a valid unit name
 
-            Check_Ada_Name (Name => Src, Unit => Unit_Name);
+            Check_Ada_Name
+              (Name => Src (Src'First .. Src_Last), Unit => Unit_Name);
          end;
 
       end;
@@ -4958,19 +4984,17 @@ package body Prj.Nmsc is
 
             --  Put the file name in the list of sources of the project
 
-            if not File_Name_Recorded then
-               String_Element_Table.Increment_Last
-                 (In_Tree.String_Elements);
-               In_Tree.String_Elements.Table
-                 (String_Element_Table.Last
-                   (In_Tree.String_Elements)) :=
-                 (Value         => Canonical_File_Name,
-                  Display_Value => File_Name,
-                  Location      => No_Location,
-                  Flag          => False,
-                  Next          => Nil_String,
-                  Index         => Unit_Index);
-            end if;
+            String_Element_Table.Increment_Last
+              (In_Tree.String_Elements);
+            In_Tree.String_Elements.Table
+              (String_Element_Table.Last
+                 (In_Tree.String_Elements)) :=
+              (Value         => Canonical_File_Name,
+               Display_Value => File_Name,
+               Location      => No_Location,
+               Flag          => False,
+               Next          => Nil_String,
+               Index         => Unit_Index);
 
             if Current_Source = Nil_String then
                Data.Sources := String_Element_Table.Last

gcc/ada/prj-part.adb

@@ -78,7 +78,7 @@ package body Prj.Part is
       Table_Index_Type     => With_Id,
       Table_Low_Bound      => 1,
       Table_Initial        => 10,
-      Table_Increment      => 50,
+      Table_Increment      => 100,
       Table_Name           => "Prj.Part.Withs");
    --  Table used to store temporarily paths and locations of imported
    --  projects. These imported projects will be effectively parsed after the
@@ -95,7 +95,7 @@ package body Prj.Part is
       Table_Index_Type     => Nat,
       Table_Low_Bound      => 1,
       Table_Initial        => 10,
-      Table_Increment      => 50,
+      Table_Increment      => 100,
       Table_Name           => "Prj.Part.Project_Stack");
    --  This table is used to detect circular dependencies
    --  for imported and extended projects and to get the project ids of
@@ -459,7 +459,15 @@ package body Prj.Part is
       Current_Directory : constant String := Get_Current_Dir;
       Dummy : Boolean;
 
+      Real_Project_File_Name : String_Access :=
+                                 Osint.To_Canonical_File_Spec
+                                   (Project_File_Name);
+
    begin
+      if Real_Project_File_Name = null then
+         Real_Project_File_Name := new String'(Project_File_Name);
+      end if;
+
       Project := Empty_Node;
 
       if Current_Verbosity >= Medium then
@@ -470,10 +478,12 @@ package body Prj.Part is
 
       declare
          Path_Name : constant String :=
-                       Project_Path_Name_Of (Project_File_Name,
+                       Project_Path_Name_Of (Real_Project_File_Name.all,
                                              Directory   => Current_Directory);
 
       begin
+         Free (Real_Project_File_Name);
+
          Prj.Err.Initialize;
          Prj.Err.Scanner.Set_Comment_As_Token (Store_Comments);
          Prj.Err.Scanner.Set_End_Of_Line_As_Token (Store_Comments);

gcc/ada/prj-proc.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2001-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-2006, 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- --
@@ -2340,6 +2340,16 @@ package body Prj.Proc is
             Project := Processed_Projects.Get (Name);
 
             if Project /= No_Project then
+
+               --  Make sure that, when a project is extended, the project id
+               --  of the project extending it is recorded in its data, even
+               --  when it has already been processed as an imported project.
+               --  This is for virtually extended projects.
+
+               if Extended_By /= No_Project then
+                  In_Tree.Projects.Table (Project).Extended_By := Extended_By;
+               end if;
+
                return;
             end if;