From dc8b370ac022cd0cfd0a5498f2cb8dbc0a286cf6 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 4 Jan 2013 10:24:06 +0100 Subject: [PATCH] [multiple changes] 2013-01-04 Pascal Obry * prj-nmsc.adb: Minor reformatting. 2013-01-04 Vincent Celier * makeutl.ads (Root_Environment): New variable, moved rom gprbuild (Load_Standard_Base): New Boolean variable, moved from gprbuild. * prj-conf.adb (Check_Builder_Switches): New procedure to check for switch --RTS in package Builder. If a runtime specified by --RTS is a relative path name, but not a base name, then find the path on the Project Search Path. (Do_Autoconf): Call Check_Builder_Switches. (Locate_Runtime): New procedure, moved from gprbuild, to get the absolute paths of runtimes when they are not specified as a base name. * prj-conf.ads (Locate_Runtime): New procedure, moved from gprbuild. From-SVN: r194893 --- gcc/ada/ChangeLog | 18 +++ gcc/ada/makeutl.ads | 11 ++ gcc/ada/prj-conf.adb | 297 ++++++++++++++++++++++++++----------------- gcc/ada/prj-conf.ads | 10 +- gcc/ada/prj-nmsc.adb | 32 +++-- 5 files changed, 231 insertions(+), 137 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index fe3d35100e9..85ee0f75d2a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +2013-01-04 Pascal Obry + + * prj-nmsc.adb: Minor reformatting. + +2013-01-04 Vincent Celier + + * makeutl.ads (Root_Environment): New variable, moved rom + gprbuild (Load_Standard_Base): New Boolean variable, moved + from gprbuild. + * prj-conf.adb (Check_Builder_Switches): New procedure to check + for switch --RTS in package Builder. If a runtime specified + by --RTS is a relative path name, but not a base name, then + find the path on the Project Search Path. + (Do_Autoconf): Call Check_Builder_Switches. + (Locate_Runtime): New procedure, moved from gprbuild, to get the + absolute paths of runtimes when they are not specified as a base name. + * prj-conf.ads (Locate_Runtime): New procedure, moved from gprbuild. + 2013-01-04 Ed Schonberg * sem_ch3.adb (Build_Private_Derived_Type): Set diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads index ade5accb02b..9570fef6628 100644 --- a/gcc/ada/makeutl.ads +++ b/gcc/ada/makeutl.ads @@ -44,6 +44,14 @@ package Makeutl is type Fail_Proc is access procedure (S : String); -- Pointer to procedure which outputs a failure message + Root_Environment : Prj.Tree.Environment; + -- The environment coming from environment variables and command line + -- switches. When we do not have an aggregate project, this is used for + -- parsing the project tree. When we have an aggregate project, this is + -- used to parse the aggregate project; the latter then generates another + -- environment (with additional external values and project path) to parse + -- the aggregated projects. + Default_Config_Name : constant String := "default.cgpr"; -- Name of the configuration file used by gprbuild and generated by -- gprconfig by default. @@ -71,6 +79,9 @@ package Makeutl is Create_Map_File_Switch : constant String := "--create-map-file"; -- Switch to create a map file when an executable is linked + Load_Standard_Base : Boolean := True; + -- False when gprbuild is called with --db- + package Directories is new Table.Table (Table_Component_Type => Path_Name_Type, Table_Index_Type => Integer, diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index 3da9c1bdaa5..4e799b6ab09 100644 --- a/gcc/ada/prj-conf.adb +++ b/gcc/ada/prj-conf.adb @@ -628,6 +628,9 @@ package body Prj.Conf is -- Generate a new config file through gprconfig. In case of error, this -- raises the Invalid_Config exception with an appropriate message + procedure Check_Builder_Switches; + -- Check for switch --RTS in package Builder + function Get_Config_Switches return Argument_List_Access; -- Return the --config switches to use for gprconfig @@ -636,6 +639,119 @@ package body Prj.Conf is -- explicitly specified it. We haven't checked the file system, nor do -- we need to at this stage. + ---------------------------- + -- Check_Builder_Switches -- + ---------------------------- + + procedure Check_Builder_Switches is + Get_RTS_Switches : constant Boolean := + RTS_Languages.Get_First = No_Name; + -- If no switch --RTS have been specified on the command line, look + -- for --RTS switches in the Builder switches. + + Builder : constant Package_Id := + Value_Of (Name_Builder, Project.Decl.Packages, Shared); + + Switch_Array_Id : Array_Element_Id; + -- The Switches to be checked + + procedure Check_Switches; + -- Check the switches in Switch_Array_Id + + -------------------- + -- Check_Switches -- + -------------------- + + procedure Check_Switches is + Switch_Array : Array_Element; + Switch_List : String_List_Id := Nil_String; + Switch : String_Element; + Lang : Name_Id; + Lang_Last : Positive; + + begin + while Switch_Array_Id /= No_Array_Element loop + Switch_Array := + Shared.Array_Elements.Table (Switch_Array_Id); + + Switch_List := Switch_Array.Value.Values; + List_Loop : while Switch_List /= Nil_String loop + Switch := Shared.String_Elements.Table (Switch_List); + + if Switch.Value /= No_Name then + Get_Name_String (Switch.Value); + + if Get_RTS_Switches + and then Name_Len >= 7 + and then Name_Buffer (1 .. 5) = "--RTS" + then + if Name_Buffer (6) = '=' then + if not Runtime_Name_Set_For (Name_Ada) then + Set_Runtime_For + (Name_Ada, + Name_Buffer (7 .. Name_Len)); + Locate_Runtime (Name_Ada, Project_Tree); + end if; + + elsif Name_Len > 7 + and then Name_Buffer (6) = ':' + and then Name_Buffer (7) /= '=' + then + Lang_Last := 7; + while Lang_Last < Name_Len + and then Name_Buffer (Lang_Last + 1) /= '=' + loop + Lang_Last := Lang_Last + 1; + end loop; + + if Name_Buffer (Lang_Last + 1) = '=' then + declare + RTS : constant String := + Name_Buffer (Lang_Last + 2 .. Name_Len); + begin + Name_Buffer (1 .. Lang_Last - 6) := + Name_Buffer (7 .. Lang_Last); + Name_Len := Lang_Last - 6; + To_Lower (Name_Buffer (1 .. Name_Len)); + Lang := Name_Find; + + if not Runtime_Name_Set_For (Lang) then + Set_Runtime_For (Lang, RTS); + Locate_Runtime (Lang, Project_Tree); + end if; + end; + end if; + end if; + end if; + end if; + + Switch_List := Switch.Next; + end loop List_Loop; + + Switch_Array_Id := Switch_Array.Next; + end loop; + end Check_Switches; + + -- Start of processing for Check_Builder_Switches + + begin + if Builder /= No_Package then + Switch_Array_Id := + Value_Of + (Name => Name_Switches, + In_Arrays => Shared.Packages.Table (Builder).Decl.Arrays, + Shared => Shared); + Check_Switches; + + Switch_Array_Id := + Value_Of + (Name => Name_Default_Switches, + In_Arrays => Shared.Packages.Table (Builder).Decl.Arrays, + Shared => Shared); + Check_Switches; + end if; + end Check_Builder_Switches; + ----------------------- -- Default_File_Name -- ----------------------- @@ -647,10 +763,11 @@ package body Prj.Conf is begin if Target_Name /= "" then if Ada_RTS /= "" then - return Target_Name & '-' & Ada_RTS - & Config_Project_File_Extension; + return + Target_Name & '-' & Ada_RTS & Config_Project_File_Extension; else - return Target_Name & Config_Project_File_Extension; + return + Target_Name & Config_Project_File_Extension; end if; elsif Ada_RTS /= "" then @@ -1012,117 +1129,6 @@ package body Prj.Conf is end case; end if; - -- If no switch --RTS have been specified on the command line, - -- look for --RTS switches in the Builder switches. - - if RTS_Languages.Get_First = No_Name then - declare - Builder : constant Package_Id := - Value_Of - (Name_Builder, Project.Decl.Packages, Shared); - Switch_Array_Id : Array_Element_Id; - - procedure Check_RTS_Switches; - -- Take into account eventual switches --RTS in - -- Switch_Array_Id. - - ------------------------ - -- Check_RTS_SWitches -- - ------------------------ - - procedure Check_RTS_Switches is - Switch_Array : Array_Element; - Switch_List : String_List_Id := Nil_String; - Switch : String_Element; - Lang : Name_Id; - Lang_Last : Positive; - - begin - while Switch_Array_Id /= No_Array_Element loop - Switch_Array := - Shared.Array_Elements.Table (Switch_Array_Id); - - Switch_List := Switch_Array.Value.Values; - while Switch_List /= Nil_String loop - Switch := - Shared.String_Elements.Table (Switch_List); - - if Switch.Value /= No_Name then - Get_Name_String (Switch.Value); - - if Name_Len >= 7 and then - Name_Buffer (1 .. 5) = "--RTS" - then - if Name_Buffer (6) = '=' then - if not Runtime_Name_Set_For (Name_Ada) then - Set_Runtime_For - (Name_Ada, - Name_Buffer (7 .. Name_Len)); - end if; - - elsif Name_Len > 7 and then - Name_Buffer (6) = ':' and then - Name_Buffer (7) /= '=' - then - Lang_Last := 7; - while Lang_Last < Name_Len and then - Name_Buffer (Lang_Last + 1) /= '=' - loop - Lang_Last := Lang_Last + 1; - end loop; - - if Name_Buffer (Lang_Last + 1) = '=' then - declare - RTS : constant String := - Name_Buffer (Lang_Last + 2 .. - Name_Len); - begin - Name_Buffer (1 .. Lang_Last - 6) := - Name_Buffer (7 .. Lang_Last); - Name_Len := Lang_Last - 6; - To_Lower - (Name_Buffer (1 .. Name_Len)); - Lang := Name_Find; - - if not - Runtime_Name_Set_For (Lang) - then - Set_Runtime_For (Lang, RTS); - end if; - end; - end if; - end if; - end if; - end if; - - Switch_List := Switch.Next; - end loop; - - Switch_Array_Id := Switch_Array.Next; - end loop; - end Check_RTS_Switches; - - begin - if Builder /= No_Package then - Switch_Array_Id := - Value_Of - (Name => Name_Switches, - In_Arrays => - Shared.Packages.Table (Builder).Decl.Arrays, - Shared => Shared); - Check_RTS_Switches; - - Switch_Array_Id := - Value_Of - (Name => Name_Default_Switches, - In_Arrays => - Shared.Packages.Table (Builder).Decl.Arrays, - Shared => Shared); - Check_RTS_Switches; - end if; - end; - end if; - -- Get the config switches. This should be done only now, as some -- runtimes may have been found if the Builder switches. @@ -1135,7 +1141,7 @@ package body Prj.Conf is -- If no config file was specified, set the auto.cgpr one - if Config_File_Name = "" then + if Config_File_Name'Length = 0 then if Obj_Dir_Exists then Args (3) := new String'(Obj_Dir & Auto_Cgpr); @@ -1253,7 +1259,7 @@ package body Prj.Conf is -- Display no message if we are creating auto.cgpr, unless in -- verbose mode - if Config_File_Name /= "" + if Config_File_Name'Length > 0 or else Verbose_Mode then Write_Str ("creating "); @@ -1290,7 +1296,9 @@ package body Prj.Conf is Free (Config_File_Path); Config := No_Project; - if Config_File_Name /= "" then + Check_Builder_Switches; + + if Config_File_Name'Length > 0 then Config_File_Path := Locate_Config_File (Config_File_Name); else Config_File_Path := Locate_Config_File (Default_File_Name); @@ -1298,7 +1306,7 @@ package body Prj.Conf is if Config_File_Path = null then if (not Allow_Automatic_Generation) - and then Config_File_Name /= "" + and then Config_File_Name'Length > 0 then Raise_Invalid_Config ("could not locate main configuration project " @@ -1326,10 +1334,11 @@ package body Prj.Conf is end if; -- If the config file is not auto-generated, warn if there is any --RTS - -- switch on the command line. + -- switch, but not when the config file is generated in memory. elsif RTS_Languages.Get_First /= No_Name and then Opt.Warning_Mode /= Opt.Suppress + and then On_Load_Config = null then Write_Line ("warning: --RTS is taken into account only in auto-configuration"); @@ -1411,6 +1420,56 @@ package body Prj.Conf is end if; end Locate_Config_File; + -------------------- + -- Locate_Runtime -- + -------------------- + + procedure Locate_Runtime + (Language : Name_Id; + Project_Tree : Prj.Project_Tree_Ref) + is + function Is_Base_Name (Path : String) return Boolean; + -- Returns True if Path has no directory separator + + ------------------ + -- Is_Base_Name -- + ------------------ + + function Is_Base_Name (Path : String) return Boolean is + begin + for I in Path'Range loop + if Path (I) = Directory_Separator or else Path (I) = '/' then + return False; + end if; + end loop; + return True; + end Is_Base_Name; + + -- Local declarations + + function Find_Rts_In_Path is new Prj.Env.Find_Name_In_Path + (Check_Filename => Is_Directory); + + RTS_Name : constant String := Runtime_Name_For (Language); + + Full_Path : String_Access; + + -- Start of processing for Locate_Runtime + + begin + if not Is_Base_Name (RTS_Name) then + Full_Path := + Find_Rts_In_Path (Root_Environment.Project_Path, RTS_Name); + + if Full_Path = null then + Fail_Program (Project_Tree, "cannot find RTS " & RTS_Name); + end if; + + Set_Runtime_For (Language, Normalize_Pathname (Full_Path.all)); + Free (Full_Path); + end if; + end Locate_Runtime; + ------------------------------------ -- Parse_Project_And_Apply_Config -- ------------------------------------ diff --git a/gcc/ada/prj-conf.ads b/gcc/ada/prj-conf.ads index bc672cf868c..f283c6ed2b3 100644 --- a/gcc/ada/prj-conf.ads +++ b/gcc/ada/prj-conf.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2006-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 2006-2012, 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- -- @@ -189,4 +189,12 @@ package Prj.Conf is function Runtime_Name_Set_For (Language : Name_Id) return Boolean; -- Returns True only if Set_Runtime_For has been called for the Language + procedure Locate_Runtime + (Language : Name_Id; + Project_Tree : Prj.Project_Tree_Ref); + -- If RTS_Name is a base name (a name without path separator), then + -- do nothing. Otherwise, convert it to an absolute path (possibly by + -- searching it in the project path) and call Set_Runtime_For with the + -- absolute path. Fail the program if the path does not exist. + end Prj.Conf; diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 77d1cfd1cde..b956292a6e6 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -6727,9 +6727,9 @@ package body Prj.Nmsc is procedure Free (Data : in out Project_Processing_Data) is begin - Source_Names_Htable.Reset (Data.Source_Names); - Unit_Exceptions_Htable.Reset (Data.Unit_Exceptions); - Excluded_Sources_Htable.Reset (Data.Excluded); + Source_Names_Htable.Reset (Data.Source_Names); + Unit_Exceptions_Htable.Reset (Data.Unit_Exceptions); + Excluded_Sources_Htable.Reset (Data.Excluded); end Free; ------------------------------- @@ -6996,9 +6996,9 @@ package body Prj.Nmsc is if Name_Loc.Source.Naming_Exception = Inherited then declare - Proj : Project_Id := Name_Loc.Source.Project.Extends; - Iter : Source_Iterator; - Src : Source_Id; + Proj : Project_Id := Name_Loc.Source.Project.Extends; + Iter : Source_Iterator; + Src : Source_Id; begin while Proj /= No_Project loop Iter := For_Each_Source (Data.Tree, Proj); @@ -7149,10 +7149,10 @@ package body Prj.Nmsc is (Path : Path_Information; Rank : Natural) return Boolean is - Dir : Dir_Type; - Name : String (1 .. 250); - Last : Natural; - Found : Path_Information; + Dir : Dir_Type; + Name : String (1 .. 250); + Last : Natural; + Found : Path_Information; Success : Boolean := False; begin @@ -7198,10 +7198,10 @@ package body Prj.Nmsc is Rank : Natural) return Boolean is Path_Str : constant String := Get_Name_String (Path.Display_Name); - Dir : Dir_Type; - Name : String (1 .. 250); - Last : Natural; - Success : Boolean := False; + Dir : Dir_Type; + Name : String (1 .. 250); + Last : Natural; + Success : Boolean := False; begin Debug_Output ("looking for subdirs of ", Name_Id (Path.Display_Name)); @@ -8321,9 +8321,7 @@ package body Prj.Nmsc is procedure Check_Not_Defined (Name : Name_Id) is Var : constant Prj.Variable_Value := Prj.Util.Value_Of - (Name, - Project.Decl.Attributes, - Data.Tree.Shared); + (Name, Project.Decl.Attributes, Data.Tree.Shared); begin if not Var.Default then Error_Msg_Name_1 := Name;