[multiple changes]

2009-11-30  Thomas Quinot  <quinot@adacore.com>

	* osint.adb: Minor reformatting

2009-11-30  Vincent Celier  <celier@adacore.com>

	* makeutl.ads, makeutl.adb (Base_Name_Index_For): New function to get
	the base name of a main without the extension, with an eventual source
	index.
	(Mains.Get_Index): New procedure to set the source index of a main
	(Mains.Get_Index): New function to get the source index of a main
	* prj-attr.adb: New attributes Config_Body_File_Name_Index,
	Config_Spec_File_Name_Index, Multi_Unit_Object_Separator and
	Multi_Unit_Switches.
	* prj-nmsc.adb (Process_Compiler): Takle into account new attributes
	Config_Body_File_Name_Index, Config_Spec_File_Name_Index,
	Multi_Unit_Object_Separator and Multi_Unit_Switches.
	Allow only one character for Multi_Unit_Object_Separator.
	* prj-proc.adb (Process_Declarative_Items): Take into account the
	source indexes in indexes of associative array attribute declarations.
	* prj.adb (Object_Name): New function to get the object file name for
	units in multi-unit sources.
	* prj.ads (Language_Config): New components Multi_Unit_Switches,
	Multi_Unit_Object_Separator Config_Body_Index and Config_Spec_Index.
	(Object_Name): New function to get the object file name for units in
	multi-unit sources.
	* snames.ads-tmpl: New standard names Config_Body_File_Name_Index,
	Config_Spec_File_Name_Index, Multi_Unit_Object_Separator and
	Multi_Unit_Switches.

From-SVN: r154782

gcc/ada/ChangeLog

+2009-11-30  Thomas Quinot  <quinot@adacore.com>
+
+	* osint.adb: Minor reformatting
+
+2009-11-30  Vincent Celier  <celier@adacore.com>
+
+	* makeutl.ads, makeutl.adb (Base_Name_Index_For): New function to get
+	the base name of a main without the extension, with an eventual source
+	index.
+	(Mains.Get_Index): New procedure to set the source index of a main
+	(Mains.Get_Index): New function to get the source index of a main
+	* prj-attr.adb: New attributes Config_Body_File_Name_Index,
+	Config_Spec_File_Name_Index, Multi_Unit_Object_Separator and
+	Multi_Unit_Switches.
+	* prj-nmsc.adb (Process_Compiler): Takle into account new attributes
+	Config_Body_File_Name_Index, Config_Spec_File_Name_Index,
+	Multi_Unit_Object_Separator and Multi_Unit_Switches.
+	Allow only one character for Multi_Unit_Object_Separator.
+	* prj-proc.adb (Process_Declarative_Items): Take into account the
+	source indexes in indexes of associative array attribute declarations.
+	* prj.adb (Object_Name): New function to get the object file name for
+	units in multi-unit sources.
+	* prj.ads (Language_Config): New components Multi_Unit_Switches,
+	Multi_Unit_Object_Separator Config_Body_Index and Config_Spec_Index.
+	(Object_Name): New function to get the object file name for units in
+	multi-unit sources.
+	* snames.ads-tmpl: New standard names Config_Body_File_Name_Index,
+	Config_Spec_File_Name_Index, Multi_Unit_Object_Separator and
+	Multi_Unit_Switches.
+
 2009-11-30  Arnaud Charlet  <charlet@adacore.com>
 
 	* s-tassta.adb: Update comment.

gcc/ada/makeutl.adb

@@ -157,6 +157,45 @@ package body Makeutl is
       end if;
    end Add_Linker_Option;
 
+   -------------------------
+   -- Base_Name_Index_For --
+   -------------------------
+
+   function Base_Name_Index_For
+     (Main            : String;
+      Main_Index      : Int;
+      Index_Separator : Character) return File_Name_Type
+   is
+      Result : File_Name_Type;
+   begin
+      Name_Len := 0;
+      Add_Str_To_Name_Buffer (Base_Name (Main));
+
+      --  Remove the extension, if any, that is the last part of the base
+      --  name starting with a dot and following some characters.
+
+      for J in reverse 2 .. Name_Len loop
+         if Name_Buffer (J) = '.' then
+            Name_Len := J - 1;
+            exit;
+         end if;
+      end loop;
+
+      --  Add the index info, if index is different from 0
+
+      if Main_Index > 0 then
+         Add_Char_To_Name_Buffer (Index_Separator);
+
+         declare
+            Img : constant String := Main_Index'Img;
+         begin
+            Add_Str_To_Name_Buffer (Img (2 .. Img'Last));
+         end;
+      end if;
+      Result := Name_Find;
+      return Result;
+   end Base_Name_Index_For;
+
    ------------------------------
    -- Check_Source_Info_In_ALI --
    ------------------------------
@@ -599,6 +638,7 @@ package body Makeutl is
 
       type File_And_Loc is record
          File_Name : File_Name_Type;
+         Index     : Int := 0;
          Location  : Source_Ptr := No_Location;
       end record;
 
@@ -623,7 +663,7 @@ package body Makeutl is
          Name_Len := 0;
          Add_Str_To_Name_Buffer (Name);
          Names.Increment_Last;
-         Names.Table (Names.Last) := (Name_Find, No_Location);
+         Names.Table (Names.Last) := (Name_Find, 0, No_Location);
       end Add_Main;
 
       ------------
@@ -636,6 +676,19 @@ package body Makeutl is
          Mains.Reset;
       end Delete;
 
+      ---------------
+      -- Get_Index --
+      ---------------
+
+      function Get_Index return Int is
+      begin
+         if Current in Names.First .. Names.Last then
+            return Names.Table (Current).Index;
+         else
+            return 0;
+         end if;
+      end Get_Index;
+
       ------------------
       -- Get_Location --
       ------------------
@@ -681,6 +734,17 @@ package body Makeutl is
          Current := 0;
       end Reset;
 
+      ---------------
+      -- Set_Index --
+      ---------------
+
+      procedure Set_Index (Index : Int) is
+      begin
+         if Names.Last > 0 then
+            Names.Table (Names.Last).Index := Index;
+         end if;
+      end Set_Index;
+
       ------------------
       -- Set_Location --
       ------------------

gcc/ada/makeutl.ads

@@ -60,7 +60,14 @@ package Makeutl is
    function Create_Name (Name : String) return File_Name_Type;
    function Create_Name (Name : String) return Name_Id;
    function Create_Name (Name : String) return Path_Name_Type;
-   --  Get the Name_Id of a name
+   --  Get an id for a name
+
+   function Base_Name_Index_For
+     (Main            : String;
+      Main_Index      : Int;
+      Index_Separator : Character) return File_Name_Type;
+   --  Returns the base name of Main, without the extension, plus the
+   --  Index_Separator followed by the Main_Index, if Main_Index is not 0.
 
    function Executable_Prefix_Path return String;
    --  Return the absolute path parent directory of the directory where the
@@ -143,6 +150,8 @@ package Makeutl is
       procedure Add_Main (Name : String);
       --  Add one main to the table
 
+      procedure Set_Index (Index : Int);
+
       procedure Set_Location (Location : Source_Ptr);
       --  Set the location of the last main added. By default, the location is
       --  No_Location.
@@ -157,6 +166,8 @@ package Makeutl is
       --  Increase the index and return the next main. If table is exhausted,
       --  return an empty string.
 
+      function Get_Index return Int;
+
       function Get_Location return Source_Ptr;
       --  Get the location of the current main
 

gcc/ada/osint.adb

@@ -138,7 +138,7 @@ package body Osint is
       Path_Len  : Integer) return String_Access;
    --  Converts a C String to an Ada String. Are we doing this to avoid withing
    --  Interfaces.C.Strings ???
-   --  Caller must free result
+   --  Caller must free result.
 
    function Include_Dir_Default_Prefix return String_Access;
    --  Same as exported version, except returns a String_Access

gcc/ada/prj-attr.adb

@@ -179,6 +179,8 @@ package body Prj.Attr is
    "Sapath_syntax#" &
    "Saobject_file_suffix#" &
    "Laobject_file_switches#" &
+   "Lamulti_unit_switches#" &
+   "Samulti_unit_object_separator#" &
 
    --  Configuration - Mapping files
 
@@ -190,8 +192,10 @@ package body Prj.Attr is
 
    "Laconfig_file_switches#" &
    "Saconfig_body_file_name#" &
-   "Saconfig_spec_file_name#" &
+   "Saconfig_body_file_name_index#" &
    "Saconfig_body_file_name_pattern#" &
+   "Saconfig_spec_file_name#" &
+   "Saconfig_spec_file_name_index#" &
    "Saconfig_spec_file_name_pattern#" &
    "Saconfig_file_unique#" &
 

gcc/ada/prj-nmsc.adb

@@ -1431,6 +1431,34 @@ package body Prj.Nmsc is
                                 From_List => Element.Value.Values,
                                 In_Tree   => Data.Tree);
 
+                        when Name_Multi_Unit_Switches =>
+                           Put (Into_List =>
+                                  Lang_Index.Config.Multi_Unit_Switches,
+                                From_List => Element.Value.Values,
+                                In_Tree   => Data.Tree);
+
+                        when Name_Multi_Unit_Object_Separator =>
+                           Get_Name_String (Element.Value.Value);
+
+                           if Name_Len /= 1 then
+                              Error_Msg
+                                (Data.Flags,
+                                 "multi-unit object separator must have " &
+                                 "a single character",
+                                 Element.Value.Location, Project);
+
+                           elsif Name_Buffer (1) = ' ' then
+                              Error_Msg
+                                (Data.Flags,
+                                 "multi-unit object separator cannot be " &
+                                 "a space",
+                                 Element.Value.Location, Project);
+
+                           else
+                              Lang_Index.Config.Multi_Unit_Object_Separator :=
+                                Name_Buffer (1);
+                           end if;
+
                         when Name_Path_Syntax =>
                            begin
                               Lang_Index.Config.Path_Syntax :=
@@ -1552,10 +1580,18 @@ package body Prj.Nmsc is
                            Lang_Index.Config.Config_Body :=
                              Element.Value.Value;
 
+                        when Name_Config_Body_File_Name_Index =>
+
+                           --  Attribute Config_Body_File_Name_Index
+                           --     ( < Language > )
+
+                           Lang_Index.Config.Config_Body_Index :=
+                             Element.Value.Value;
+
                         when Name_Config_Body_File_Name_Pattern =>
 
                            --  Attribute Config_Body_File_Name_Pattern
-                           --  (<language>)
+                           --    (<language>)
 
                            Lang_Index.Config.Config_Body_Pattern :=
                              Element.Value.Value;
@@ -1567,10 +1603,18 @@ package body Prj.Nmsc is
                            Lang_Index.Config.Config_Spec :=
                              Element.Value.Value;
 
+                        when Name_Config_Spec_File_Name_Index =>
+
+                           --  Attribute Config_Spec_File_Name_Index
+                           --    ( < Language > )
+
+                           Lang_Index.Config.Config_Spec_Index :=
+                             Element.Value.Value;
+
                         when Name_Config_Spec_File_Name_Pattern =>
 
                            --  Attribute Config_Spec_File_Name_Pattern
-                           --  (<language>)
+                           --    (<language>)
 
                            Lang_Index.Config.Config_Spec_Pattern :=
                              Element.Value.Value;

gcc/ada/prj-proc.adb

@@ -1871,6 +1871,9 @@ package body Prj.Proc is
                            Index_Name : Name_Id :=
                              Associative_Array_Index_Of
                                (Current_Item, From_Project_Node_Tree);
+                           Source_Index : constant Int :=
+                             Source_Index_Of
+                               (Current_Item, From_Project_Node_Tree);
                            The_Array : Array_Id;
                            The_Array_Element : Array_Element_Id :=
                                                  No_Array_Element;
@@ -1943,12 +1946,15 @@ package body Prj.Proc is
                            end if;
 
                            --  Look in the list, if any, to find an element
-                           --  with the same index.
+                           --  with the same index and same source index.
 
                            while The_Array_Element /= No_Array_Element
                              and then
-                               In_Tree.Array_Elements.Table
+                               (In_Tree.Array_Elements.Table
                                  (The_Array_Element).Index /= Index_Name
+                                or else
+                                In_Tree.Array_Elements.Table
+                                 (The_Array_Element).Src_Index /= Source_Index)
                            loop
                               The_Array_Element :=
                                 In_Tree.Array_Elements.Table
@@ -1968,9 +1974,7 @@ package body Prj.Proc is
                               In_Tree.Array_Elements.Table
                                 (The_Array_Element) :=
                                   (Index  => Index_Name,
-                                   Src_Index =>
-                                     Source_Index_Of
-                                       (Current_Item, From_Project_Node_Tree),
+                                   Src_Index => Source_Index,
                                    Index_Case_Sensitive =>
                                      not Case_Insensitive
                                        (Current_Item, From_Project_Node_Tree),

gcc/ada/prj.adb

@@ -679,6 +679,39 @@ package body Prj is
       end if;
    end Object_Name;
 
+   function Object_Name
+     (Source_File_Name   : File_Name_Type;
+      Source_Index       : Int;
+      Index_Separator    : Character;
+      Object_File_Suffix : Name_Id := No_Name) return File_Name_Type
+   is
+      Index_Img : constant String := Source_Index'Img;
+      Last      : Natural;
+   begin
+      Get_Name_String (Source_File_Name);
+      Last := Name_Len;
+
+      while Last > 1 and then Name_Buffer (Last) /= '.' loop
+         Last := Last - 1;
+      end loop;
+
+      if Last > 1 then
+         Name_Len := Last - 1;
+      end if;
+
+      Add_Char_To_Name_Buffer (Index_Separator);
+      Add_Str_To_Name_Buffer (Index_Img (2 .. Index_Img'Last));
+
+      if Object_File_Suffix = No_Name then
+         Add_Str_To_Name_Buffer (Object_Suffix);
+
+      else
+         Add_Str_To_Name_Buffer (Get_Name_String (Object_File_Suffix));
+      end if;
+
+      return Name_Find;
+   end Object_Name;
+
    ----------------------
    -- Record_Temp_File --
    ----------------------

gcc/ada/prj.ads

@@ -160,7 +160,7 @@ package Prj is
       end case;
    end record;
    --  Values for variables and array elements. Default is True if the
-   --  current value is the default one for the variable
+   --  current value is the default one for the variable.
 
    Nil_Variable_Value : constant Variable_Value;
    --  Value of a non existing variable or array element
@@ -278,8 +278,8 @@ package Prj is
    function Hash (Name : Name_Id)        return Header_Num;
    function Hash (Name : File_Name_Type) return Header_Num;
    function Hash (Name : Path_Name_Type) return Header_Num;
-   function Hash (Project : Project_Id) return Header_Num;
-   --  Used for computing hash values for names put into above hash table
+   function Hash (Project : Project_Id)  return Header_Num;
+   --  Used for computing hash values for names put into hash tables
 
    type Language_Kind is (File_Based, Unit_Based);
    --  Type for the kind of language. All languages are file based, except Ada
@@ -433,6 +433,14 @@ package Prj is
       --  The list of final switches that are required as a minimum to invoke
       --  the compiler driver.
 
+      Multi_Unit_Switches                 : Name_List_Index := No_Name_List;
+      --  The switch(es) to indicate the index of a unit in a multi-source
+      --  file.
+
+      Multi_Unit_Object_Separator         : Character         := ' ';
+      --  The string separating the base name of a source from the index of
+      --  the unit in a multi-source file, in the object file name.
+
       Path_Syntax                  : Path_Syntax_Kind := Host;
       --  Value may be Canonical (Unix style) or Host (host syntax, for example
       --  on VMS for DEC C).
@@ -515,14 +523,22 @@ package Prj is
       --  The template for a pragma Source_File_Name(_Project) for a specific
       --  file name of a body.
 
-      Config_Spec           : Name_Id         := No_Name;
+      Config_Body_Index          : Name_Id         := No_Name;
       --  The template for a pragma Source_File_Name(_Project) for a specific
-      --  file name of a spec.
+      --  file name of a body in a multi-source file.
 
       Config_Body_Pattern   : Name_Id         := No_Name;
       --  The template for a pragma Source_File_Name(_Project) for a naming
       --  body pattern.
 
+      Config_Spec           : Name_Id         := No_Name;
+      --  The template for a pragma Source_File_Name(_Project) for a specific
+      --  file name of a spec.
+
+      Config_Spec_Index      : Name_Id         := No_Name;
+      --  The template for a pragma Source_File_Name(_Project) for a specific
+      --  file name of a spec in a multi-source file.
+
       Config_Spec_Pattern   : Name_Id         := No_Name;
       --  The template for a pragma Source_File_Name(_Project) for a naming
       --  spec pattern.
@@ -561,6 +577,8 @@ package Prj is
                            Compiler_Driver_Path         => null,
                            Compiler_Leading_Required_Switches  => No_Name_List,
                            Compiler_Trailing_Required_Switches => No_Name_List,
+                           Multi_Unit_Switches          => No_Name_List,
+                           Multi_Unit_Object_Separator  => ' ',
                            Path_Syntax                  => Canonical,
                            Object_File_Suffix           => No_Name,
                            Object_File_Switches         => No_Name_List,
@@ -582,8 +600,10 @@ package Prj is
                            Objects_Path                 => No_Name,
                            Objects_Path_File            => No_Name,
                            Config_Body                  => No_Name,
-                           Config_Spec                  => No_Name,
+                           Config_Body_Index            => No_Name,
                            Config_Body_Pattern          => No_Name,
+                           Config_Spec                  => No_Name,
+                           Config_Spec_Index            => No_Name,
                            Config_Spec_Pattern          => No_Name,
                            Config_File_Unique           => False,
                            Binder_Driver                => No_File,
@@ -1362,6 +1382,14 @@ package Prj is
       Object_File_Suffix : Name_Id := No_Name) return File_Name_Type;
    --  Returns the object file name corresponding to a source file name
 
+   function Object_Name
+     (Source_File_Name   : File_Name_Type;
+      Source_Index       : Int;
+      Index_Separator    : Character;
+      Object_File_Suffix : Name_Id := No_Name) return File_Name_Type;
+   --  Returns the object file name corresponding to a unit in a multi-source
+   --  file.
+
    function Dependency_Name
      (Source_File_Name : File_Name_Type;
       Dependency       : Dependency_File_Kind) return File_Name_Type;

gcc/ada/snames.ads-tmpl

@@ -1033,10 +1033,12 @@ package Snames is
    Name_Compiler                         : constant Name_Id := N + $;
    Name_Compiler_Command                 : constant Name_Id := N + $; --  GPR
    Name_Config_Body_File_Name            : constant Name_Id := N + $;
+   Name_Config_Body_File_Name_Index      : constant Name_Id := N + $;
    Name_Config_Body_File_Name_Pattern    : constant Name_Id := N + $;
    Name_Config_File_Switches             : constant Name_Id := N + $;
    Name_Config_File_Unique               : constant Name_Id := N + $;
    Name_Config_Spec_File_Name            : constant Name_Id := N + $;
+   Name_Config_Spec_File_Name_Index      : constant Name_Id := N + $;
    Name_Config_Spec_File_Name_Pattern    : constant Name_Id := N + $;
    Name_Configuration                    : constant Name_Id := N + $;
    Name_Cross_Reference                  : constant Name_Id := N + $;
@@ -1103,6 +1105,8 @@ package Snames is
    Name_Mapping_Body_Suffix              : constant Name_Id := N + $;
    Name_Max_Command_Line_Length          : constant Name_Id := N + $;
    Name_Metrics                          : constant Name_Id := N + $;
+   Name_Multi_Unit_Object_Separator      : constant Name_Id := N + $;
+   Name_Multi_Unit_Switches              : constant Name_Id := N + $;
    Name_Naming                           : constant Name_Id := N + $;
    Name_None                             : constant Name_Id := N + $;
    Name_Object_File_Suffix               : constant Name_Id := N + $;