[multiple changes]

2014-01-27  Robert Dewar  <dewar@adacore.com>

	* sem_res.adb (Resolve_Comparison_Op): Add type name/location
	to unordered msg.
	(Resolve_Range): Add type name/location to unordered msg.

2014-01-27  Claire Dross  <dross@adacore.com>

	* a-cofove.adb/s (Copy): Add precondition so that Copy (Source,
	Capacity) is only called with Capacity >= Length (Source) and
	Capacity in Capacity_Range.
	* a-cfdlli.adb/s, a-cfhase.adb/s, a-cfhama.adb/s, a-cforse.adb/s,
	a-cforma.adb/s (Copy): Add precondition so that Copy (Source, Capacity)
	is only called with Capacity >= Source.Capacity. Raise Capacity_Error
	in the code is this is not the case.

2014-01-27  Thomas Quinot  <quinot@adacore.com>

	* sem_ch4.adb (Analyze_Selected_Component): Fix handling of
	selected component in an instance where the component of the
	actual is not visibile at instantiation.

From-SVN: r207146

15 files changed, 98 insertions, 31 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a57ac28..237c3e0 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,25 @@
+2014-01-27  Robert Dewar  <dewar@adacore.com>
+
+	* sem_res.adb (Resolve_Comparison_Op): Add type name/location
+	to unordered msg.
+	(Resolve_Range): Add type name/location to unordered msg.
+
+2014-01-27  Claire Dross  <dross@adacore.com>
+
+	* a-cofove.adb/s (Copy): Add precondition so that Copy (Source,
+	Capacity) is only called with Capacity >= Length (Source) and
+	Capacity in Capacity_Range.
+	* a-cfdlli.adb/s, a-cfhase.adb/s, a-cfhama.adb/s, a-cforse.adb/s,
+	a-cforma.adb/s (Copy): Add precondition so that Copy (Source, Capacity)
+	is only called with Capacity >= Source.Capacity. Raise Capacity_Error
+	in the code is this is not the case.
+
+2014-01-27  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_ch4.adb (Analyze_Selected_Component): Fix handling of
+	selected component in an instance where the component of the
+	actual is not visibile at instantiation.
+
 2014-01-27  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_ch6.adb: sem_ch6.adb (Set_Actual_Subtypes): If the type
diff --git a/gcc/ada/a-cfdlli.adb b/gcc/ada/a-cfdlli.adb
index 34668bd..982c1b7 100644
--- a/gcc/ada/a-cfdlli.adb
+++ b/gcc/ada/a-cfdlli.adb
@@ -229,6 +229,10 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
       P : List (C);
 
    begin
+      if 0 < Capacity and then Capacity < Source.Capacity then
+         raise Capacity_Error;
+      end if;
+
       N := 1;
       while N <= Source.Capacity loop
          P.Nodes (N).Prev := Source.Nodes (N).Prev;
diff --git a/gcc/ada/a-cfdlli.ads b/gcc/ada/a-cfdlli.ads
index 660eb18..54f1886 100644
--- a/gcc/ada/a-cfdlli.ads
+++ b/gcc/ada/a-cfdlli.ads
@@ -84,7 +84,8 @@ package Ada.Containers.Formal_Doubly_Linked_Lists is
    procedure Assign (Target : in out List; Source : List) with
      Pre => Target.Capacity >= Length (Source);
 
-   function Copy (Source : List; Capacity : Count_Type := 0) return List;
+   function Copy (Source : List; Capacity : Count_Type := 0) return List with
+     Pre => Capacity = 0 or else Capacity >= Source.Capacity;
 
    function Element
      (Container : List;
diff --git a/gcc/ada/a-cfhama.adb b/gcc/ada/a-cfhama.adb
index 3ab4af2..9384238 100644
--- a/gcc/ada/a-cfhama.adb
+++ b/gcc/ada/a-cfhama.adb
@@ -207,6 +207,10 @@ package body Ada.Containers.Formal_Hashed_Maps is
       Cu     : Cursor;
 
    begin
+      if 0 < Capacity and then Capacity < Source.Capacity then
+         raise Capacity_Error;
+      end if;
+
       Target.Length := Source.Length;
       Target.Free := Source.Free;
 
diff --git a/gcc/ada/a-cfhama.ads b/gcc/ada/a-cfhama.ads
index 5366655..71eed2b 100644
--- a/gcc/ada/a-cfhama.ads
+++ b/gcc/ada/a-cfhama.ads
@@ -100,7 +100,7 @@ package Ada.Containers.Formal_Hashed_Maps is
      (Source   : Map;
       Capacity : Count_Type := 0) return Map
    with
-     Pre => Capacity >= Source.Capacity;
+     Pre => Capacity = 0 or else Capacity >= Source.Capacity;
    --  Copy returns a container stricty equal to Source. It must have
    --  the same cursors associated with each element. Therefore:
    --  - capacity=0 means use container.capacity as capacity of target
diff --git a/gcc/ada/a-cfhase.adb b/gcc/ada/a-cfhase.adb
index 451ec32..96f0d05 100644
--- a/gcc/ada/a-cfhase.adb
+++ b/gcc/ada/a-cfhase.adb
@@ -233,6 +233,10 @@ package body Ada.Containers.Formal_Hashed_Sets is
       Cu     : Cursor;
 
    begin
+      if 0 < Capacity and then Capacity < Source.Capacity then
+         raise Capacity_Error;
+      end if;
+
       Target.Length := Source.Length;
       Target.Free := Source.Free;
 
diff --git a/gcc/ada/a-cfhase.ads b/gcc/ada/a-cfhase.ads
index d470e1b..a3fc63d 100644
--- a/gcc/ada/a-cfhase.ads
+++ b/gcc/ada/a-cfhase.ads
@@ -106,7 +106,7 @@ package Ada.Containers.Formal_Hashed_Sets is
      (Source   : Set;
       Capacity : Count_Type := 0) return Set
    with
-     Pre => Capacity >= Source.Capacity;
+     Pre => Capacity = 0 or else Capacity >= Source.Capacity;
 
    function Element
      (Container : Set;
diff --git a/gcc/ada/a-cforma.adb b/gcc/ada/a-cforma.adb
index ac76391..33cd101 100644
--- a/gcc/ada/a-cforma.adb
+++ b/gcc/ada/a-cforma.adb
@@ -283,6 +283,10 @@ package body Ada.Containers.Formal_Ordered_Maps is
       N    : Count_Type;
 
    begin
+      if 0 < Capacity and then Capacity < Source.Capacity then
+         raise Capacity_Error;
+      end if;
+
       return Target : Map (Count_Type'Max (Source.Capacity, Capacity)) do
          if Length (Source) > 0 then
             Target.Length := Source.Length;
diff --git a/gcc/ada/a-cforma.ads b/gcc/ada/a-cforma.ads
index 00cd398..a942676 100644
--- a/gcc/ada/a-cforma.ads
+++ b/gcc/ada/a-cforma.ads
@@ -92,7 +92,7 @@ package Ada.Containers.Formal_Ordered_Maps is
      Pre => Target.Capacity >= Length (Source);
 
    function Copy (Source : Map; Capacity : Count_Type := 0) return Map with
-     Pre => Capacity >= Source.Capacity;
+     Pre => Capacity = 0 or else Capacity >= Source.Capacity;
 
    function Key (Container : Map; Position : Cursor) return Key_Type with
      Pre => Has_Element (Container, Position);
diff --git a/gcc/ada/a-cforse.adb b/gcc/ada/a-cforse.adb
index 22e9222..1b202f0 100644
--- a/gcc/ada/a-cforse.adb
+++ b/gcc/ada/a-cforse.adb
@@ -320,6 +320,10 @@ package body Ada.Containers.Formal_Ordered_Sets is
       Target : Set (Count_Type'Max (Source.Capacity, Capacity));
 
    begin
+      if 0 < Capacity and then Capacity < Source.Capacity then
+         raise Capacity_Error;
+      end if;
+
       if Length (Source) > 0 then
          Target.Length := Source.Length;
          Target.Root   := Source.Root;
diff --git a/gcc/ada/a-cforse.ads b/gcc/ada/a-cforse.ads
index 0116e8f..e935be5 100644
--- a/gcc/ada/a-cforse.ads
+++ b/gcc/ada/a-cforse.ads
@@ -94,7 +94,7 @@ package Ada.Containers.Formal_Ordered_Sets is
      Pre => Target.Capacity >= Length (Source);
 
    function Copy (Source : Set; Capacity : Count_Type := 0) return Set with
-     Pre => Capacity >= Source.Capacity;
+     Pre => Capacity = 0 or else Capacity >= Source.Capacity;
 
    function Element
      (Container : Set;
diff --git a/gcc/ada/a-cofove.adb b/gcc/ada/a-cofove.adb
index 6789f71..93372e1 100644
--- a/gcc/ada/a-cofove.adb
+++ b/gcc/ada/a-cofove.adb
@@ -301,10 +301,10 @@ package body Ada.Containers.Formal_Vectors is
    begin
       if Capacity = 0 then
          C := LS;
-      elsif Capacity >= LS then
+      elsif Capacity >= LS and then Capacity in Capacity_Range then
          C := Capacity;
       else
-         raise Constraint_Error;
+         raise Capacity_Error;
       end if;
 
       return Target : Vector (C) do
diff --git a/gcc/ada/a-cofove.ads b/gcc/ada/a-cofove.ads
index 2c451fb8..313165c 100644
--- a/gcc/ada/a-cofove.ads
+++ b/gcc/ada/a-cofove.ads
@@ -125,7 +125,7 @@ package Ada.Containers.Formal_Vectors is
      (Source   : Vector;
       Capacity : Count_Type := 0) return Vector
    with
-     Pre => Length (Source) <= Capacity;
+     Pre => Length (Source) <= Capacity and then Capacity in Capacity_Range;
 
    function To_Cursor
      (Container : Vector;
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 1512a7a..51e7f09 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -3943,6 +3943,7 @@ package body Sem_Ch4 is
       --  searches have failed. When the match is found (it always will be),
       --  the Etype of both N and Sel are set from this component, and the
       --  entity of Sel is set to reference this component.
+      --  ??? no longer true that a match is found ???
 
       function Has_Mode_Conformant_Spec (Comp : Entity_Id) return Boolean;
       --  It is known that the parent of N denotes a subprogram call. Comp
@@ -3971,9 +3972,7 @@ package body Sem_Ch4 is
             Next_Component (Comp);
          end loop;
 
-         --  This must succeed because code was legal in the generic
-
-         raise Program_Error;
+         --  Need comment on what is going on when we fall through ???
       end Find_Component_In_Instance;
 
       ------------------------------
@@ -4607,27 +4606,47 @@ package body Sem_Ch4 is
             Analyze_Selected_Component (N);
             return;
 
-         --  Similarly, if this is the actual for a formal derived type, the
-         --  component inherited from the generic parent may not be visible
-         --  in the actual, but the selected component is legal.
+         --  Similarly, if this is the actual for a formal derived type, or
+         --  a derived type thereof, the component inherited from the generic
+         --  parent may not be visible in the actual, but the selected
+         --  component is legal. Climb up the derivation chain of the generic
+         --  parent type until we find the proper ancestor type.
 
-         elsif Ekind (Prefix_Type) = E_Record_Subtype_With_Private
-           and then Is_Generic_Actual_Type (Prefix_Type)
-           and then Present (Full_View (Prefix_Type))
-         then
-            Find_Component_In_Instance
-              (Generic_Parent_Type (Parent (Prefix_Type)));
-            return;
+         elsif In_Instance and then Is_Tagged_Type (Prefix_Type) then
+            declare
+               Par : Entity_Id := Prefix_Type;
+            begin
+               --  Climb up derivation chain to generic actual subtype
+
+               while not Is_Generic_Actual_Type (Par) loop
+                  if Ekind (Par) = E_Record_Type then
+                     Par := Parent_Subtype (Par);
+                     exit when No (Par);
+                  else
+                     exit when Par = Etype (Par);
+                     Par := Etype (Par);
+                  end if;
+               end loop;
 
-         --  Finally, the formal and the actual may be private extensions,
-         --  but the generic is declared in a child unit of the parent, and
-         --  an additional step is needed to retrieve the proper scope.
+               if Present (Par) and then Is_Generic_Actual_Type (Par) then
+                  --  Now look for component in ancestor types
 
-         elsif In_Instance
-           and then Present (Parent_Subtype (Etype (Base_Type (Prefix_Type))))
-         then
-            Find_Component_In_Instance
-              (Parent_Subtype (Etype (Base_Type (Prefix_Type))));
+                  Par := Generic_Parent_Type (Declaration_Node (Par));
+                  loop
+                     Find_Component_In_Instance (Par);
+                     exit when Present (Entity (Sel))
+                       or else Par = Etype (Par);
+                     Par := Etype (Par);
+                  end loop;
+               end if;
+            end;
+
+            --  The search above must have eventually succeeded, since the
+            --  selected component was legal in the generic.
+
+            if No (Entity (Sel)) then
+               raise Program_Error;
+            end if;
             return;
 
          --  Component not found, specialize error message when appropriate
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 7e2e55c..aff4b47 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -6287,7 +6287,10 @@ package body Sem_Res is
       --  Check comparison on unordered enumeration
 
       if Bad_Unordered_Enumeration_Reference (N, Etype (L)) then
-         Error_Msg_N ("comparison on unordered enumeration type?U?", N);
+         Error_Msg_Sloc := Sloc (Etype (L));
+         Error_Msg_NE
+           ("comparison on unordered enumeration type& declared#?U?",
+            N, Etype (L));
       end if;
 
       --  Evaluate the relation (note we do this after the above check since
@@ -8830,7 +8833,9 @@ package body Sem_Res is
 
         and then not First_Last_Ref
       then
-         Error_Msg ("subrange of unordered enumeration type?U?", Sloc (N));
+         Error_Msg_Sloc := Sloc (Typ);
+         Error_Msg_NE
+           ("subrange of unordered enumeration type& declared#?U?", N, Typ);
       end if;
 
       Check_Unset_Reference (L);