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

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;