Skip to content

R
riscv-gcc-1
Commit 141e448f by Vincent Celier Committed by Arnaud Charlet
Options

prj-util.adb (Executable_Of): New String parameter Language. 

2008-04-08  Vincent Celier  <celier@adacore.com>

	* 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
parent 8bc65441
Showing with 102 additions and 36 deletions
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;
......
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;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment