From: Vincent Celier Date: Tue, 8 Apr 2008 06:54:31 +0000 (+0200) Subject: prj-util.adb (Executable_Of): New String parameter Language. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=141e448f5ee81f604427895390ac89bf10de10ee;p=gcc.git prj-util.adb (Executable_Of): New String parameter Language. 2008-04-08 Vincent Celier * prj-util.adb (Executable_Of): New String parameter Language. When Ada_Main is False and Language is not empty, attempt to remove the body suffix or the spec suffix of the language to get the base of the executable file name. (Put): New Boolean parameter Lower_Case, defauilted to False. When Lower_Case is True, put the value in lower case in the name list. (Executable_Of): If there is no executable suffix in the configuration, then do not modify Executable_Extension_On_Target. * prj-util.ads (Executable_Of): New String parameter Language, defaulted to the empty string. (Put): New Boolean parameter Lower_Case, defauilted to False From-SVN: r134046 --- diff --git a/gcc/ada/prj-util.adb b/gcc/ada/prj-util.adb index c41c3da25ad..2f953a36018 100644 --- a/gcc/ada/prj-util.adb +++ b/gcc/ada/prj-util.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2008, 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,7 +109,8 @@ package body Prj.Util is In_Tree : Project_Tree_Ref; Main : File_Name_Type; Index : Int; - Ada_Main : Boolean := True) return File_Name_Type + Ada_Main : Boolean := True; + Language : String := "") return File_Name_Type is pragma Assert (Project /= No_Project); @@ -136,13 +137,55 @@ package body Prj.Util is Naming : constant Naming_Data := In_Tree.Projects.Table (Project).Naming; - Body_Suffix : constant String := - Body_Suffix_Of (In_Tree, "ada", Naming); + Spec_Suffix : Name_Id := No_Name; + Body_Suffix : Name_Id := No_Name; - Spec_Suffix : constant String := - Spec_Suffix_Of (In_Tree, "ada", Naming); + Spec_Suffix_Length : Natural := 0; + Body_Suffix_Length : Natural := 0; + + procedure Get_Suffixes + (B_Suffix : String; + S_Suffix : String); + -- Get the non empty suffixes in variables Spec_Suffix and Body_Suffix + + ------------------ + -- Get_Suffixes -- + ------------------ + + procedure Get_Suffixes + (B_Suffix : String; + S_Suffix : String) + is + begin + if B_Suffix'Length > 0 then + Name_Len := B_Suffix'Length; + Name_Buffer (1 .. Name_Len) := B_Suffix; + Body_Suffix := Name_Find; + Body_Suffix_Length := B_Suffix'Length; + end if; + + if S_Suffix'Length > 0 then + Name_Len := S_Suffix'Length; + Name_Buffer (1 .. Name_Len) := S_Suffix; + Spec_Suffix := Name_Find; + Spec_Suffix_Length := S_Suffix'Length; + end if; + end Get_Suffixes; + + -- Start of processing for Executable_Of begin + if Ada_Main then + Get_Suffixes + (B_Suffix => Body_Suffix_Of (In_Tree, "ada", Naming), + S_Suffix => Spec_Suffix_Of (In_Tree, "ada", Naming)); + + elsif Language /= "" then + Get_Suffixes + (B_Suffix => Body_Suffix_Of (In_Tree, Language, Naming), + S_Suffix => Spec_Suffix_Of (In_Tree, Language, Naming)); + end if; + if Builder_Package /= No_Package then if Get_Mode = Multi_Language then Executable_Suffix_Name := @@ -176,21 +219,21 @@ package body Prj.Util is Truncated : Boolean := False; begin - if Last > Body_Suffix'Length - and then Name (Last - Body_Suffix'Length + 1 .. Last) = - Body_Suffix + if Last > Natural (Length_Of_Name (Body_Suffix)) + and then Name (Last - Body_Suffix_Length + 1 .. Last) = + Get_Name_String (Body_Suffix) then Truncated := True; - Last := Last - Body_Suffix'Length; + Last := Last - Body_Suffix_Length; end if; if not Truncated - and then Last > Spec_Suffix'Length - and then Name (Last - Spec_Suffix'Length + 1 .. Last) = - Spec_Suffix + and then Last > Spec_Suffix_Length + and then Name (Last - Spec_Suffix_Length + 1 .. Last) = + Get_Name_String (Spec_Suffix) then Truncated := True; - Last := Last - Spec_Suffix'Length; + Last := Last - Spec_Suffix_Length; end if; if Truncated then @@ -238,21 +281,24 @@ package body Prj.Util is -- otherwise remove any suffix ('.' followed by other characters), if -- there is one. - if Ada_Main and then Name_Len > Body_Suffix'Length - and then Name_Buffer (Name_Len - Body_Suffix'Length + 1 .. Name_Len) = - Body_Suffix + if Body_Suffix /= No_Name + and then Name_Len > Body_Suffix_Length + and then Name_Buffer (Name_Len - Body_Suffix_Length + 1 .. Name_Len) = + Get_Name_String (Body_Suffix) then -- Found the body termination, remove it - Name_Len := Name_Len - Body_Suffix'Length; + Name_Len := Name_Len - Body_Suffix_Length; - elsif Ada_Main and then Name_Len > Spec_Suffix'Length - and then Name_Buffer (Name_Len - Spec_Suffix'Length + 1 .. Name_Len) = - Spec_Suffix + elsif Spec_Suffix /= No_Name + and then Name_Len > Spec_Suffix_Length + and then + Name_Buffer (Name_Len - Spec_Suffix_Length + 1 .. Name_Len) = + Get_Name_String (Spec_Suffix) then -- Found the spec termination, remove it - Name_Len := Name_Len - Spec_Suffix'Length; + Name_Len := Name_Len - Spec_Suffix_Length; else -- Remove any suffix, if there is one @@ -284,8 +330,13 @@ package body Prj.Util is Result : File_Name_Type; begin - Executable_Extension_On_Target := - In_Tree.Projects.Table (Project).Config.Executable_Suffix; + if In_Tree.Projects.Table (Project).Config.Executable_Suffix /= + No_Name + then + Executable_Extension_On_Target := + In_Tree.Projects.Table (Project).Config.Executable_Suffix; + end if; + Result := Executable_Name (Name_Find); Executable_Extension_On_Target := Saved_EEOT; return Result; @@ -418,20 +469,22 @@ package body Prj.Util is --------- procedure Put - (Into_List : in out Name_List_Index; - From_List : String_List_Id; - In_Tree : Project_Tree_Ref) + (Into_List : in out Name_List_Index; + From_List : String_List_Id; + In_Tree : Project_Tree_Ref; + Lower_Case : Boolean := False) is Current_Name : Name_List_Index; List : String_List_Id; Element : String_Element; Last : Name_List_Index := Name_List_Table.Last (In_Tree.Name_Lists); + Value : Name_Id; begin Current_Name := Into_List; - while Current_Name /= No_Name_List and then - In_Tree.Name_Lists.Table (Current_Name).Next /= No_Name_List + while Current_Name /= No_Name_List + and then In_Tree.Name_Lists.Table (Current_Name).Next /= No_Name_List loop Current_Name := In_Tree.Name_Lists.Table (Current_Name).Next; end loop; @@ -439,10 +492,16 @@ package body Prj.Util is List := From_List; while List /= Nil_String loop Element := In_Tree.String_Elements.Table (List); + Value := Element.Value; + + if Lower_Case then + Get_Name_String (Value); + To_Lower (Name_Buffer (1 .. Name_Len)); + Value := Name_Find; + end if; Name_List_Table.Append - (In_Tree.Name_Lists, - (Name => Element.Value, Next => No_Name_List)); + (In_Tree.Name_Lists, (Name => Value, Next => No_Name_List)); Last := Last + 1; diff --git a/gcc/ada/prj-util.ads b/gcc/ada/prj-util.ads index 24c90aab529..e2a9558e5eb 100644 --- a/gcc/ada/prj-util.ads +++ b/gcc/ada/prj-util.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2008, 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,23 +27,30 @@ package Prj.Util is + -- ??? throughout this spec, parameters are not well enough documented + function Executable_Of (Project : Project_Id; In_Tree : Project_Tree_Ref; Main : File_Name_Type; Index : Int; - Ada_Main : Boolean := True) return File_Name_Type; + Ada_Main : Boolean := True; + Language : String := "") 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 -- Executable_Suffix is specified, add this suffix, otherwise add the -- standard executable suffix for the platform. + -- What is Ada_Main??? + -- What is Language??? procedure Put - (Into_List : in out Name_List_Index; - From_List : String_List_Id; - In_Tree : Project_Tree_Ref); + (Into_List : in out Name_List_Index; + From_List : String_List_Id; + In_Tree : Project_Tree_Ref; + Lower_Case : Boolean := False); -- Append a name list to a string list + -- Describe parameters??? procedure Duplicate (This : in out Name_List_Index;