[multiple changes]

2010-10-08  Thomas Quinot  <quinot@adacore.com>

	* xsnames.adb: Remove obsolete file.
	* make.adb, sem_ch8.adb, einfo.ads: Minor reformatting.

2010-10-08  Ed Schonberg  <schonberg@adacore.com>

	* exp_aggr.adb: Complete previous change.

2010-10-08  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Check_Return_Subtype): The subtype indication in an
	extended return must match statically the return subtype of the
	enclosing function if the type is an elementary type or if it is
	constrained.

2010-10-08  Vincent Celier  <celier@adacore.com>

	* prj-nmsc.adb (Add_Source): Report all duplicate units and source file
	names.  Do not report the same duplicate unit several times.
	* prj.ads (Source_Data): New Boolean component Duplicate_Unit,
	defaulted to False, to avoid reporting the same unit as duplicate
	several times.

From-SVN: r165160

9 files changed, 47 insertions, 253 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a61e306..b35cf85 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,27 @@
+2010-10-08  Thomas Quinot  <quinot@adacore.com>
+
+	* xsnames.adb: Remove obsolete file.
+	* make.adb, sem_ch8.adb, einfo.ads: Minor reformatting.
+
+2010-10-08  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_aggr.adb: Complete previous change.
+
+2010-10-08  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch6.adb (Check_Return_Subtype): The subtype indication in an
+	extended return must match statically the return subtype of the
+	enclosing function if the type is an elementary type or if it is
+	constrained.
+
+2010-10-08  Vincent Celier  <celier@adacore.com>
+
+	* prj-nmsc.adb (Add_Source): Report all duplicate units and source file
+	names.  Do not report the same duplicate unit several times.
+	* prj.ads (Source_Data): New Boolean component Duplicate_Unit,
+	defaulted to False, to avoid reporting the same unit as duplicate
+	several times.
+
 2010-10-08  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_aggr.adb (Resolve_Array_Aggregate): If the expression in an
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 074eefc..5611278 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -6863,7 +6863,7 @@ package Einfo is
    --  Empty is returned.
 
    function Get_Record_Representation_Clause (E : Entity_Id) return Node_Id;
-   --  Searches the Rep_Item chain for a given entyt E, for a record
+   --  Searches the Rep_Item chain for a given entity E, for a record
    --  representation clause, and if found, returns it. Returns Empty
    --  if no such clause is found.
 
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index ba3d5de..e60f216 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -5599,7 +5599,9 @@ package body Exp_Aggr is
       --  aggregates for C++ imported types must be expanded.
 
       if Ada_Version >= Ada_05 and then Is_Inherently_Limited_Type (Typ) then
-         if Nkind (Parent (N)) /= N_Object_Declaration then
+         if not Nkind_In (Parent (N), N_Object_Declaration,
+                                      N_Component_Association)
+         then
             Convert_To_Assignments (N, Typ);
 
          elsif Nkind (N) = N_Extension_Aggregate
diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb
index f88de1a..8774ba7 100644
--- a/gcc/ada/make.adb
+++ b/gcc/ada/make.adb
@@ -1916,8 +1916,7 @@ package body Make is
                if ALI_Project = No_Project then
                   ALI := No_ALI_Id;
 
-                  Verbose_Msg
-                    (Lib_File, " wrong object directory");
+                  Verbose_Msg (Lib_File, " wrong object directory");
                   return;
                end if;
 
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index 59f10fe..a8af37f 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -705,9 +705,13 @@ package body Prj.Nmsc is
                --  (for instance because of symbolic links).
 
                elsif Source.Path.Name /= Path.Name then
-                  Error_Msg_Name_1 := Unit;
-                  Error_Msg
-                    (Data.Flags, "duplicate unit %%", Location, Project);
+                  if not Source.Duplicate_Unit then
+                     Error_Msg_Name_1 := Unit;
+                     Error_Msg
+                       (Data.Flags, "\duplicate unit %%", Location, Project);
+                     Source.Duplicate_Unit := True;
+                  end if;
+
                   Add_Src := False;
                end if;
             end if;
diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads
index 4fc6c93..84c825f 100644
--- a/gcc/ada/prj.ads
+++ b/gcc/ada/prj.ads
@@ -765,6 +765,9 @@ package Prj is
       Naming_Exception : Boolean := False;
       --  True if the source has an exceptional name
 
+      Duplicate_Unit : Boolean := False;
+      --  True when a duplicate unit has been reported for this source
+
       Next_In_Lang : Source_Id := No_Source;
       --  Link to another source of the same language in the same project
    end record;
@@ -799,6 +802,7 @@ package Prj is
                        Switches_Path          => No_Path,
                        Switches_TS            => Empty_Time_Stamp,
                        Naming_Exception       => False,
+                       Duplicate_Unit         => False,
                        Next_In_Lang           => No_Source);
 
    package Source_Paths_Htable is new Simple_HTable
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index d1ec09a..e74aaf7 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -620,7 +620,12 @@ package body Sem_Ch6 is
                   Subtype_Ind);
             end if;
 
-            if Is_Constrained (R_Type) then
+            --  AI05-103 : for elementary types, subtypes must statically
+            --  match.
+
+            if Is_Constrained (R_Type)
+              or else Is_Access_Type (R_Type)
+            then
                if not Subtypes_Statically_Match (R_Stm_Type, R_Type) then
                   Error_Msg_N
                     ("subtype must statically match function result subtype",
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 1ea8277..2e3b22f 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -3076,7 +3076,7 @@ package body Sem_Ch8 is
 
       --  The replacement of a discriminant by the corresponding discriminal
       --  is not done for a task discriminant that appears in a default
-      --  expression of an entry parameter. See Expand_Discriminant in exp_ch2
+      --  expression of an entry parameter. See Exp_Ch2.Expand_Discriminant
       --  for details on their handling.
 
       elsif Is_Concurrent_Type (Scope (E)) then
diff --git a/gcc/ada/xsnames.adb b/gcc/ada/xsnames.adb
deleted file mode 100644
index d43631a..0000000
--- a/gcc/ada/xsnames.adb
+++ /dev/null
@@ -1,244 +0,0 @@
-------------------------------------------------------------------------------
---                                                                          --
---                          GNAT SYSTEM UTILITIES                           --
---                                                                          --
---                              X S N A M E S                               --
---                                                                          --
---                                 B o d y                                  --
---                                                                          --
---          Copyright (C) 1992-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- --
--- ware  Foundation;  either version 3,  or (at your option) any later ver- --
--- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
--- for  more details.  You should have  received  a copy of the GNU General --
--- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
--- http://www.gnu.org/licenses for a complete copy of the license.          --
---                                                                          --
--- GNAT was originally developed  by the GNAT team at  New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc.      --
---                                                                          --
-------------------------------------------------------------------------------
-
---  This utility is used to make a new version of the Snames package when new
---  names are added to the spec, the existing versions of snames.ads and
---  snames.adb and snames.h are read, and updated to match the set of names in
---  snames.ads. The updated versions are written to snames.ns, snames.nb (new
---  spec/body), and snames.nh (new header file).
-
-with Ada.Strings.Unbounded;         use Ada.Strings.Unbounded;
-with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;
-with Ada.Strings.Maps;              use Ada.Strings.Maps;
-with Ada.Strings.Maps.Constants;    use Ada.Strings.Maps.Constants;
-with Ada.Text_IO;                   use Ada.Text_IO;
-
-with GNAT.Spitbol;                  use GNAT.Spitbol;
-with GNAT.Spitbol.Patterns;         use GNAT.Spitbol.Patterns;
-
-procedure XSnames is
-
-   InB  : File_Type;
-   InS  : File_Type;
-   OutS : File_Type;
-   OutB : File_Type;
-   InH  : File_Type;
-   OutH : File_Type;
-
-   A, B  : VString := Nul;
-   Line  : VString := Nul;
-   Name  : VString := Nul;
-   Name1 : VString := Nul;
-   Oval  : VString := Nul;
-   Restl : VString := Nul;
-
-   Tdigs : constant Pattern := Any (Decimal_Digit_Set) &
-                               Any (Decimal_Digit_Set) &
-                               Any (Decimal_Digit_Set);
-
-   Name_Ref : constant Pattern := Span (' ') * A & Break (' ') * Name
-                                  & Span (' ') * B
-                                  & ": constant Name_Id := N + " & Tdigs
-                                  & ';' & Rest * Restl;
-
-   Get_Name : constant Pattern := "Name_" & Rest * Name1;
-   Chk_Low  : constant Pattern := Pos (0) & Any (Lower_Set) & Rest & Pos (1);
-   Findu    : constant Pattern := Span ('u') * A;
-
-   Val : Natural;
-
-   Xlate_U_Und : constant Character_Mapping := To_Mapping ("u", "_");
-
-   M : Match_Result;
-
-   type Header_Symbol is (None, Attr, Conv, Prag);
-   --  A symbol in the header file
-
-   procedure Output_Header_Line (S : Header_Symbol);
-   --  Output header line
-
-   Header_Attr : aliased String := "Attr";
-   Header_Conv : aliased String := "Convention";
-   Header_Prag : aliased String := "Pragma";
-   --  Prefixes used in the header file
-
-   type String_Ptr is access all String;
-   Header_Prefix : constant array (Header_Symbol) of String_Ptr :=
-                     (null,
-                      Header_Attr'Access,
-                      Header_Conv'Access,
-                      Header_Prag'Access);
-
-   --  Patterns used in the spec file
-
-   Get_Attr : constant Pattern := Span (' ') & "Attribute_"
-                                  & Break (",)") * Name1;
-   Get_Conv : constant Pattern := Span (' ') & "Convention_"
-                                  & Break (",)") * Name1;
-   Get_Prag : constant Pattern := Span (' ') & "Pragma_"
-                                  & Break (",)") * Name1;
-
-   type Header_Symbol_Counter is array (Header_Symbol) of Natural;
-   Header_Counter : Header_Symbol_Counter := (0, 0, 0, 0);
-
-   Header_Current_Symbol : Header_Symbol := None;
-   Header_Pending_Line : VString := Nul;
-
-   ------------------------
-   -- Output_Header_Line --
-   ------------------------
-
-   procedure Output_Header_Line (S : Header_Symbol) is
-   begin
-      --  Skip all the #define for S-prefixed symbols in the header.
-      --  Of course we are making implicit assumptions:
-      --   (1) No newline between symbols with the same prefix.
-      --   (2) Prefix order is the same as in snames.ads.
-
-      if Header_Current_Symbol /= S then
-         declare
-            Pat : constant String := "#define  " & Header_Prefix (S).all;
-            In_Pat : Boolean := False;
-
-         begin
-            if Header_Current_Symbol /= None then
-               Put_Line (OutH, Header_Pending_Line);
-            end if;
-
-            loop
-               Line := Get_Line (InH);
-
-               if Match (Line, Pat) then
-                  In_Pat := True;
-               elsif In_Pat then
-                  Header_Pending_Line := Line;
-                  exit;
-               else
-                  Put_Line (OutH, Line);
-               end if;
-            end loop;
-
-            Header_Current_Symbol := S;
-         end;
-      end if;
-
-      --  Now output the line
-
-      Put_Line (OutH, "#define  " & Header_Prefix (S).all
-                  & "_" & Name1 & (30 - Length (Name1)) * ' '
-                  & Header_Counter (S));
-      Header_Counter (S) := Header_Counter (S) + 1;
-   end Output_Header_Line;
-
---  Start of processing for XSnames
-
-begin
-   Open (InB, In_File, "snames.adb");
-   Open (InS, In_File, "snames.ads");
-   Open (InH, In_File, "snames.h");
-
-   Create (OutS, Out_File, "snames.ns");
-   Create (OutB, Out_File, "snames.nb");
-   Create (OutH, Out_File, "snames.nh");
-
-   Anchored_Mode := True;
-   Val := 0;
-
-   loop
-      Line := Get_Line (InB);
-      exit when Match (Line, "   Preset_Names");
-      Put_Line (OutB, Line);
-   end loop;
-
-   Put_Line (OutB, Line);
-
-   LoopN : while not End_Of_File (InS) loop
-      Line := Get_Line (InS);
-
-      if not Match (Line, Name_Ref) then
-         Put_Line (OutS, Line);
-
-         if Match (Line, Get_Attr) then
-            Output_Header_Line (Attr);
-         elsif Match (Line, Get_Conv) then
-            Output_Header_Line (Conv);
-         elsif Match (Line, Get_Prag) then
-            Output_Header_Line (Prag);
-         end if;
-      else
-         Oval := Lpad (V (Val), 3, '0');
-
-         if Match (Name, "Last_") then
-            Oval := Lpad (V (Val - 1), 3, '0');
-         end if;
-
-         Put_Line
-           (OutS, A & Name & B & ": constant Name_Id := N + "
-            & Oval & ';' & Restl);
-
-         if Match (Name, Get_Name) then
-            Name := Name1;
-            Val := Val + 1;
-
-            if Match (Name, Findu, M) then
-               Replace (M, Translate (A, Xlate_U_Und));
-               Translate (Name, Lower_Case_Map);
-
-            elsif not Match (Name, "Op_", "") then
-               Translate (Name, Lower_Case_Map);
-
-            else
-               Name := 'O' & Translate (Name, Lower_Case_Map);
-            end if;
-
-            if Name = "error" then
-               Name := V ("<error>");
-            end if;
-
-            if not Match (Name, Chk_Low) then
-               Put_Line (OutB, "     """ & Name & "#"" &");
-            end if;
-         end if;
-      end if;
-   end loop LoopN;
-
-   loop
-      Line := Get_Line (InB);
-      exit when Match (Line, "     ""#"";");
-   end loop;
-
-   Put_Line (OutB, Line);
-
-   while not End_Of_File (InB) loop
-      Line := Get_Line (InB);
-      Put_Line (OutB, Line);
-   end loop;
-
-   Put_Line (OutH, Header_Pending_Line);
-   while not End_Of_File (InH) loop
-      Line := Get_Line (InH);
-      Put_Line (OutH, Line);
-   end loop;
-end XSnames;