From ddd6e5ae32e20e53172a8597ead37034b381321c Mon Sep 17 00:00:00 2001 From: Vincent Celier Date: Tue, 31 Oct 2006 19:04:45 +0100 Subject: [PATCH] prj-nmsc.adb (Check_Ada_Name): For children of package A... 2006-10-31 Vincent Celier * 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 | 72 +++++++++++++++++++++++++++++--------------- gcc/ada/prj-part.adb | 16 ++++++++-- gcc/ada/prj-proc.adb | 12 +++++++- 3 files changed, 72 insertions(+), 28 deletions(-) diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 67d59201d98..88b00f4afb0 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/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 diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index 8e9f963390a..938d394b42a 100644 --- a/gcc/ada/prj-part.adb +++ b/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); diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index f79afc9e6c8..1c382ab5c40 100644 --- a/gcc/ada/prj-proc.adb +++ b/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; -- 2.30.2