[multiple changes]

2013-04-25  Matthew Heaney  <heaney@adacore.com>

	* a-rbtgbo.adb, a-crbtgo.adb (Generic_Equal): do not test for
	tampering when container empty.
	* a-crbtgk.adb (Ceiling, Find, Floor): ditto.
	(Generic_Conditional_Insert, Generic_Conditional_Insert_With_Hint):
	ditto.

2013-04-25  Ed Schonberg  <schonberg@adacore.com>

	* par-ch12.adb: Move aspects from package specification to
	generic package declaration.
	* sem_ch12.adb: Analyze aspect specifications before building
	and analyzing the generic copy, so that the generated pragmas
	are properly taken into account.
	* sem_ch13.adb: For compilation unit aspects that apply to a
	generic package declaration, insert corresponding pragmas ahead
	of visible declarations.
	* sprint.adb: Display properly the aspects of a generic type
	declaration.

2013-04-25  Robert Dewar  <dewar@adacore.com>

	* frontend.adb: Minor reformatting.

2013-04-25  Ed Schonberg  <schonberg@adacore.com>

	* einfo.ads: Extend documentation on use of Is_Private_Ancestor
	for untagged types.
	* sem_ch3.adb (Is_Visible_Component): Refine predicate for the
	case of untagged types derived from private types, to reject
	illegal selected components.

From-SVN: r198285

11 files changed, 145 insertions, 27 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ec3f06c2..21f43ac 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,36 @@
+2013-04-25  Matthew Heaney  <heaney@adacore.com>
+
+	* a-rbtgbo.adb, a-crbtgo.adb (Generic_Equal): do not test for
+	tampering when container empty.
+	* a-crbtgk.adb (Ceiling, Find, Floor): ditto.
+	(Generic_Conditional_Insert, Generic_Conditional_Insert_With_Hint):
+	ditto.
+
+2013-04-25  Ed Schonberg  <schonberg@adacore.com>
+
+	* par-ch12.adb: Move aspects from package specification to
+	generic package declaration.
+	* sem_ch12.adb: Analyze aspect specifications before building
+	and analyzing the generic copy, so that the generated pragmas
+	are properly taken into account.
+	* sem_ch13.adb: For compilation unit aspects that apply to a
+	generic package declaration, insert corresponding pragmas ahead
+	of visible declarations.
+	* sprint.adb: Display properly the aspects of a generic type
+	declaration.
+
+2013-04-25  Robert Dewar  <dewar@adacore.com>
+
+	* frontend.adb: Minor reformatting.
+
+2013-04-25  Ed Schonberg  <schonberg@adacore.com>
+
+	* einfo.ads: Extend documentation on use of Is_Private_Ancestor
+	for untagged types.
+	* sem_ch3.adb (Is_Visible_Component): Refine predicate for the
+	case of untagged types derived from private types, to reject
+	illegal selected components.
+
 2013-04-25  Gary Dismukes  <dismukes@adacore.com>
 
 	* sem_util.adb (Is_Dependent_Component_Of_Mutable_Object): Test
diff --git a/gcc/ada/a-crbtgk.adb b/gcc/ada/a-crbtgk.adb
index f1762f8..7cc3b25 100644
--- a/gcc/ada/a-crbtgk.adb
+++ b/gcc/ada/a-crbtgk.adb
@@ -45,6 +45,13 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
       X : Node_Access;
 
    begin
+      --  If the container is empty, return a result immediately, so that we do
+      --  not manipulate the tamper bits unnecessarily.
+
+      if Tree.Root = null then
+         return null;
+      end if;
+
       --  Per AI05-0022, the container implementation is required to detect
       --  element tampering by a generic actual subprogram.
 
@@ -87,6 +94,13 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
       Result : Node_Access;
 
    begin
+      --  If the container is empty, return a result immediately, so that we do
+      --  not manipulate the tamper bits unnecessarily.
+
+      if Tree.Root = null then
+         return null;
+      end if;
+
       --  Per AI05-0022, the container implementation is required to detect
       --  element tampering by a generic actual subprogram.
 
@@ -137,6 +151,13 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
       X : Node_Access;
 
    begin
+      --  If the container is empty, return a result immediately, so that we do
+      --  not manipulate the tamper bits unnecessarily.
+
+      if Tree.Root = null then
+         return null;
+      end if;
+
       --  Per AI05-0022, the container implementation is required to detect
       --  element tampering by a generic actual subprogram.
 
@@ -198,6 +219,15 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
       --  its previous neighbor, in order for the conditional insertion to
       --  succeed.
 
+      --  Handle insertion into an empty container as a special case, so that
+      --  we do not manipulate the tamper bits unnecessarily.
+
+      if Tree.Root = null then
+         Insert_Post (Tree, null, True, Node);
+         Inserted := True;
+         return;
+      end if;
+
       --  We search the tree to find the nearest neighbor of Key, which is
       --  either the smallest node greater than Key (Inserted is True), or the
       --  largest node less or equivalent to Key (Inserted is False).
@@ -227,9 +257,9 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
 
       if Inserted then
 
-         --  Either Tree is empty, or Key is less than Y. If Y is the first
-         --  node in the tree, then there are no other nodes that we need to
-         --  search for, and we insert a new node into the tree.
+         --  Key is less than Y. If Y is the first node in the tree, then there
+         --  are no other nodes that we need to search for, and we insert a new
+         --  node into the tree.
 
          if Y = Tree.First then
             Insert_Post (Tree, Y, True, Node);
@@ -316,18 +346,26 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
       --  is not a search and the only comparisons that occur are with
       --  the hint and its neighbor.
 
-      --  If Position is null, this is interpreted to mean that Key is
-      --  large relative to the nodes in the tree. If the tree is empty,
-      --  or Key is greater than the last node in the tree, then we're
-      --  done; otherwise the hint was "wrong" and we must search.
+      --  Handle insertion into an empty container as a special case, so that
+      --  we do not manipulate the tamper bits unnecessarily.
+
+      if Tree.Root = null then
+         Insert_Post (Tree, null, True, Node);
+         Inserted := True;
+         return;
+      end if;
+
+      --  If Position is null, this is interpreted to mean that Key is large
+      --  relative to the nodes in the tree. If Key is greater than the last
+      --  node in the tree, then we're done; otherwise the hint was "wrong" and
+      --  we must search.
 
       if Position = null then  -- largest
          begin
             B := B + 1;
             L := L + 1;
 
-            Compare :=
-              Tree.Last = null or else Is_Greater_Key_Node (Key, Tree.Last);
+            Compare := Is_Greater_Key_Node (Key, Tree.Last);
 
             L := L - 1;
             B := B - 1;
diff --git a/gcc/ada/a-crbtgo.adb b/gcc/ada/a-crbtgo.adb
index 6cce55d..1255ff5 100644
--- a/gcc/ada/a-crbtgo.adb
+++ b/gcc/ada/a-crbtgo.adb
@@ -646,6 +646,13 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is
          return False;
       end if;
 
+      --  If the containers are empty, return a result immediately, so as to
+      --  not manipulate the tamper bits unnecessarily.
+
+      if Left.Length = 0 then
+         return True;
+      end if;
+
       --  Per AI05-0022, the container implementation is required to detect
       --  element tampering by a generic actual subprogram.
 
diff --git a/gcc/ada/a-rbtgbo.adb b/gcc/ada/a-rbtgbo.adb
index d6df756..ddf3fe2 100644
--- a/gcc/ada/a-rbtgbo.adb
+++ b/gcc/ada/a-rbtgbo.adb
@@ -626,6 +626,13 @@ package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations is
          return False;
       end if;
 
+      --  If the containers are empty, return a result immediately, so as to
+      --  not manipulate the tamper bits unnecessarily.
+
+      if Left.Length = 0 then
+         return True;
+      end if;
+
       --  Per AI05-0022, the container implementation is required to detect
       --  element tampering by a generic actual subprogram.
 
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 38d4f22..bd58928 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -1753,12 +1753,14 @@ package Einfo is
 --       is defined for the type.
 
 --    Has_Private_Ancestor (Flag151)
---       Applies to type extensions. True if some ancestor is derived from a
---       private type, making some components invisible and aggregates illegal.
---       This flag is set at the point of derivation. The legality of the
---       aggregate must be rechecked because it also depends on the visibility
---       at the point the aggregate is resolved. See sem_aggr.adb.
---       This is part of AI05-0115.
+--       Applies to untagged derived types and to type extensions. True when
+--       some ancestor is derived from a private type, making some components
+--       invisible and aggregates illegal. Used to check the legality of
+--       selected components and aggregates. The flag is set at the point of
+--       derivation.
+--       The legality of an aggregate of a type with a private ancestor  must
+--       be checked because it also depends on the visibility at the point the
+--       aggregate is resolved. See sem_aggr.adb. This is part of AI05-0115.
 
 --    Has_Private_Declaration (Flag155)
 --       Defined in all entities. Returns True if it is the defining entity
diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb
index 08536c4..7c56ac9 100644
--- a/gcc/ada/frontend.adb
+++ b/gcc/ada/frontend.adb
@@ -185,10 +185,13 @@ begin
       --  Check for VAX Float
 
       if Targparm.VAX_Float_On_Target then
+
          --  pragma Float_Representation (VAX_Float);
+
          Opt.Float_Format := 'V';
 
          --  pragma Long_Float (G_Float);
+
          Opt.Float_Format_Long := 'G';
 
          Set_Standard_Fpt_Formats;
diff --git a/gcc/ada/par-ch12.adb b/gcc/ada/par-ch12.adb
index 06261bc..3c192f2 100644
--- a/gcc/ada/par-ch12.adb
+++ b/gcc/ada/par-ch12.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, 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- --
@@ -204,6 +204,11 @@ package body Ch12 is
          Gen_Decl := New_Node (N_Generic_Package_Declaration, Gen_Sloc);
          Set_Specification (Gen_Decl, P_Package (Pf_Spcn));
 
+         --  Aspects have been parsed by the package spec. Move them to the
+         --  generic declaration where they belong.
+
+         Move_Aspects (Specification (Gen_Decl), Gen_Decl);
+
       else
          Gen_Decl := New_Node (N_Generic_Subprogram_Declaration, Gen_Sloc);
 
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 5e1da8a..8652c70 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -3021,6 +3021,13 @@ package body Sem_Ch12 is
       Id := Defining_Entity (N);
       Generate_Definition (Id);
 
+      --  Analyze aspects now, so that generated pragmas appear in the
+      --  declarations before building and analyzing the generic copy.
+
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Id);
+      end if;
+
       --  Expansion is not applied to generic units
 
       Start_Generic;
@@ -3079,9 +3086,6 @@ package body Sem_Ch12 is
          end if;
       end if;
 
-      if Has_Aspects (N) then
-         Analyze_Aspect_Specifications (N, Id);
-      end if;
    end Analyze_Generic_Package_Declaration;
 
    --------------------------------------------
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index e6f39f5..1496912 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1986,7 +1986,9 @@ package body Sem_Ch13 is
                   --  issue of visibility delay for these aspects.
 
                   if A_Id in Library_Unit_Aspects
-                    and then Nkind (N) = N_Package_Declaration
+                    and then
+                      Nkind_In (N, N_Package_Declaration,
+                                   N_Generic_Package_Declaration)
                     and then Nkind (Parent (N)) /= N_Compilation_Unit
                   then
                      Error_Msg_N
@@ -2041,7 +2043,9 @@ package body Sem_Ch13 is
             --  In the context of a compilation unit, we directly put the
             --  pragma in the Pragmas_After list of the N_Compilation_Unit_Aux
             --  node (no delay is required here) except for aspects on a
-            --  subprogram body (see below).
+            --  subprogram body (see below) and a generic package, for which
+            --  we need to introduce the pragma before building the generic
+            --  copy (see sem_ch12).
 
             elsif Nkind (Parent (N)) = N_Compilation_Unit
               and then (Present (Aitem) or else Is_Boolean_Aspect (Aspect))
@@ -2082,6 +2086,14 @@ package body Sem_Ch13 is
 
                      Prepend (Aitem, Declarations (N));
 
+                  elsif Nkind (N) = N_Generic_Package_Declaration then
+                     if No (Visible_Declarations (Specification (N))) then
+                        Set_Visible_Declarations (Specification (N), New_List);
+                     end if;
+
+                     Prepend (Aitem,
+                       Visible_Declarations (Specification (N)));
+
                   else
                      if No (Pragmas_After (Aux)) then
                         Set_Pragmas_After (Aux, New_List);
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 9e5b8de..29abd55 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -16468,10 +16468,15 @@ package body Sem_Ch3 is
          Type_Scope     := Scope (Base_Type (Scope (C)));
       end if;
 
-      --  This test only concerns tagged types
+      --  For an untagged type derived from a private type, the only
+      --  visible components are new discriminants.
 
       if not Is_Tagged_Type (Original_Scope) then
-         return True;
+         return not Has_Private_Ancestor (Original_Scope)
+            or else In_Open_Scopes (Scope (Original_Scope))
+            or else
+              (Ekind (Original_Comp) = E_Discriminant
+                 and then Original_Scope = Type_Scope);
 
       --  If it is _Parent or _Tag, there is no visibility issue
 
@@ -17383,8 +17388,6 @@ package body Sem_Ch3 is
          --  now. We have to create a new entity with the same name, Thus we
          --  can't use Create_Itype.
 
-         --  This is messy, should be fixed ???
-
          Full := Make_Defining_Identifier (Sloc (Id), Chars (Id));
          Set_Is_Itype (Full);
          Set_Associated_Node_For_Itype (Full, Related_Nod);
diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb
index 5185c15..8526716 100644
--- a/gcc/ada/sprint.adb
+++ b/gcc/ada/sprint.adb
@@ -2499,7 +2499,8 @@ package body Sprint is
             Write_Str_With_Col_Check_Sloc ("package ");
             Sprint_Node (Defining_Unit_Name (Node));
 
-            if Nkind (Parent (Node)) = N_Package_Declaration
+            if Nkind_In (Parent (Node), N_Package_Declaration,
+                                        N_Generic_Package_Declaration)
               and then Has_Aspects (Parent (Node))
             then
                Sprint_Aspect_Specifications
@@ -3304,7 +3305,10 @@ package body Sprint is
       --  Print aspects, except for special case of package declaration,
       --  where the aspects are printed inside the package specification.
 
-      if Has_Aspects (Node) and Nkind (Node) /= N_Package_Declaration then
+      if Has_Aspects (Node)
+         and then not Nkind_In (Node, N_Package_Declaration,
+                                      N_Generic_Package_Declaration)
+      then
          Sprint_Aspect_Specifications (Node, Semicolon => True);
       end if;