[multiple changes]

2011-08-03  Gary Dismukes  <dismukes@adacore.com>

	* sem_aggr.adb (Analyze_Array_Aggregate): When checking the discrete
	choices of a named array aggregate, bail out when any choices are
	marked as Errors_Posted.

2011-08-03  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch13.adb (Expand_N_Freeze_Entity): cleanup determination of scope
	in which entity is frozen, to handle properly loop variables in
	iterators.

2011-08-03  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Set_String_Literal_Subtype): if the lower bound of the
	subtype is not static, compute the upper bound using attributes, to
	handle properly index types that are not integer types.

2011-08-03  Bob Duff  <duff@adacore.com>

	* gnat_rm.texi, gnat_ugn.texi: Fix some dangling URLs.
	Update copyright notice.

2011-08-03  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Build_Discriminant_Constraints): Only use
	Original_Discriminant if within an instance.
	* sem_ch4.adb (Analyze_Selected_Component): Ditto.

2011-08-03  Thomas Quinot  <quinot@adacore.com>

	* einfo.ads: Minor reformatting.

2011-08-03  Ed Schonberg  <schonberg@adacore.com>

	* exp_disp.adb (Check_Premature_Freezing): diagnose the presence of a
	composite type with an unfrozen subcomponent, in the profile of a
	primitive operation.

From-SVN: r177236

gcc/ada/ChangeLog

+2011-08-03  Gary Dismukes  <dismukes@adacore.com>
+
+	* sem_aggr.adb (Analyze_Array_Aggregate): When checking the discrete
+	choices of a named array aggregate, bail out when any choices are
+	marked as Errors_Posted.
+
+2011-08-03  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch13.adb (Expand_N_Freeze_Entity): cleanup determination of scope
+	in which entity is frozen, to handle properly loop variables in
+	iterators.
+
+2011-08-03  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_res.adb (Set_String_Literal_Subtype): if the lower bound of the
+	subtype is not static, compute the upper bound using attributes, to
+	handle properly index types that are not integer types.
+
+2011-08-03  Bob Duff  <duff@adacore.com>
+
+	* gnat_rm.texi, gnat_ugn.texi: Fix some dangling URLs.
+	Update copyright notice.
+
+2011-08-03  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch3.adb (Build_Discriminant_Constraints): Only use
+	Original_Discriminant if within an instance.
+	* sem_ch4.adb (Analyze_Selected_Component): Ditto.
+
+2011-08-03  Thomas Quinot  <quinot@adacore.com>
+
+	* einfo.ads: Minor reformatting.
+
+2011-08-03  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_disp.adb (Check_Premature_Freezing): diagnose the presence of a
+	composite type with an unfrozen subcomponent, in the profile of a
+	primitive operation.
+
 2011-08-03  Robert Dewar  <dewar@adacore.com>
 
 	* sem_util.ads, exp_aggr.adb, exp_ch3.adb: Minor reformatting.

gcc/ada/einfo.ads

@@ -2426,11 +2426,11 @@ package Einfo is
 --       Thus this flag has no meaning to the back end.
 
 --    Is_Limited_Composite (Flag106)
---       Present in all entities. Set for composite types that have a
---       limited component. Used to enforce the rule that operations on
---       the composite type that depend on the full view of the component
---       do not become visible until the immediate scope of the composite
---       type itself (RM 7.3.1 (5)).
+--       Present in all entities. Set for composite types that have a limited
+--       component. Used to enforce the rule that operations on the composite
+--       type that depend on the full view of the component do not become
+--       visible until the immediate scope of the composite type itself
+--       (RM 7.3.1 (5)).
 
 --    Is_Limited_Interface (Flag197)
 --       Present in record types and subtypes. True for interface types, if

gcc/ada/exp_ch13.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -43,7 +43,6 @@ with Sem_Eval; use Sem_Eval;
 with Sem_Util; use Sem_Util;
 with Sinfo;    use Sinfo;
 with Snames;   use Snames;
-with Stand;    use Stand;
 with Tbuild;   use Tbuild;
 with Uintp;    use Uintp;
 with Validsw;  use Validsw;
@@ -213,7 +212,6 @@ package body Exp_Ch13 is
    procedure Expand_N_Freeze_Entity (N : Node_Id) is
       E              : constant Entity_Id := Entity (N);
       E_Scope        : Entity_Id;
-      S              : Entity_Id;
       In_Other_Scope : Boolean;
       In_Outer_Scope : Boolean;
       Decl           : Node_Id;
@@ -306,13 +304,18 @@ package body Exp_Ch13 is
          E_Scope := Corresponding_Spec (Unit_Declaration_Node (E_Scope));
       end if;
 
-      S := Current_Scope;
-      while S /= Standard_Standard and then S /= E_Scope loop
-         S := Scope (S);
-      end loop;
+      --  If the scope of the entity is in open scopes, it is the current one
+      --  or an enclosing one, including a loop, a block, or a subprogram.
 
-      In_Other_Scope := not (S = E_Scope);
-      In_Outer_Scope := (not In_Other_Scope) and then (S /= Current_Scope);
+      if In_Open_Scopes (E_Scope) then
+         In_Other_Scope := False;
+         In_Outer_Scope := E_Scope /= Current_Scope;
+
+      --  Otherwise it is a local package or a different compilation unit.
+      else
+         In_Other_Scope := True;
+         In_Outer_Scope := False;
+      end if;
 
       --  If the entity being frozen is defined in a scope that is not
       --  currently on the scope stack, we must establish the proper

gcc/ada/exp_disp.adb

@@ -3764,7 +3764,10 @@ package body Exp_Disp is
       DT_Aggr : constant Elist_Id := New_Elmt_List;
       --  Entities marked with attribute Is_Dispatch_Table_Entity
 
-      procedure Check_Premature_Freezing (Subp : Entity_Id; Typ : Entity_Id);
+      procedure Check_Premature_Freezing
+        (Subp        : Entity_Id;
+         Tagged_Type : Entity_Id;
+         Typ         : Entity_Id);
       --  Verify that all non-tagged types in the profile of a subprogram
       --  are frozen at the point the subprogram is frozen. This enforces
       --  the rule on RM 13.14 (14) as modified by AI05-019. At the point a
@@ -3775,6 +3778,8 @@ package body Exp_Disp is
       --  Typical violation of the rule involves an object declaration that
       --  freezes a tagged type, when one of its primitive operations has a
       --  type in its profile whose full view has not been analyzed yet.
+      --  More complex cases involve composite types that have one private
+      --  unfrozen subcomponent.
 
       procedure Export_DT (Typ : Entity_Id; DT : Entity_Id; Index : Nat := 0);
       --  Export the dispatch table DT of tagged type Typ. Required to generate
@@ -3814,10 +3819,15 @@ package body Exp_Disp is
       -- Check_Premature_Freezing --
       ------------------------------
 
-      procedure Check_Premature_Freezing (Subp : Entity_Id; Typ : Entity_Id) is
+      procedure Check_Premature_Freezing
+        (Subp        : Entity_Id;
+         Tagged_Type : Entity_Id;
+         Typ         : Entity_Id)
+      is
+         Comp : Entity_Id;
       begin
          if Present (N)
-           and then  Is_Private_Type (Typ)
+           and then Is_Private_Type (Typ)
            and then No (Full_View (Typ))
            and then not Is_Generic_Type (Typ)
            and then not Is_Tagged_Type (Typ)
@@ -3828,8 +3838,26 @@ package body Exp_Disp is
               ("declaration must appear after completion of type &", N, Typ);
             Error_Msg_NE
               ("\which is an untagged type in the profile of"
-               & " primitive operation & declared#",
-               N, Subp);
+               & " primitive operation & declared#", N, Subp);
+
+         else
+            Comp := Private_Component (Typ);
+
+            if not Is_Tagged_Type (Typ)
+              and then Present (Comp)
+              and then not Is_Frozen (Comp)
+            then
+               Error_Msg_Sloc := Sloc (Subp);
+               Error_Msg_Node_2 := Subp;
+               Error_Msg_Name_1 := Chars (Tagged_Type);
+               Error_Msg_NE
+                 ("declaration must appear after completion of type &",
+                   N, Comp);
+               Error_Msg_NE
+                 ("\which is a component of untagged type& in the profile of"
+               & " primitive & of type % that is frozen by the declaration ",
+                   N, Typ);
+            end if;
          end if;
       end Check_Premature_Freezing;
 
@@ -4587,11 +4615,11 @@ package body Exp_Disp is
                begin
                   F := First_Formal (Prim);
                   while Present (F) loop
-                     Check_Premature_Freezing (Prim, Etype (F));
+                     Check_Premature_Freezing (Prim, Typ, Etype (F));
                      Next_Formal (F);
                   end loop;
 
-                  Check_Premature_Freezing (Prim, Etype (Prim));
+                  Check_Premature_Freezing (Prim, Typ, Etype (Prim));
                end;
 
                if Present (Frnodes) then

gcc/ada/gnat_rm.texi

@@ -4285,9 +4285,8 @@ Integrity Systems}, and has been approved by ISO/IEC/SC22/WG9 for inclusion in
 the next revision of the standard. The formal definition given by
 the Ada Rapporteur Group (ARG) can be found in two Ada Issues (AI-249 and
 AI-305) available at
-@url{http://www.ada-auth.org/cgi-bin/cvsweb.cgi/AIs/AI-00249.TXT} and
-@url{http://www.ada-auth.org/cgi-bin/cvsweb.cgi/AIs/AI-00305.TXT}
-respectively.
+@url{http://www.ada-auth.org/cgi-bin/cvsweb.cgi/ais/ai-00249.txt} and
+@url{http://www.ada-auth.org/cgi-bin/cvsweb.cgi/ais/ai-00305.txt}.
 
 The above set is a superset of the restrictions provided by pragma
 @code{Profile (Restricted)}, it includes six additional restrictions

gcc/ada/gnat_ugn.texi

@@ -7,7 +7,7 @@
 @c                                                                            o
 @c                             G N A T _ U G N                                o
 @c                                                                            o
-@c                     Copyright (C) 1992-2010, AdaCore                       o
+@c                     Copyright (C) 1992-2011, AdaCore                       o
 @c                                                                            o
 @c oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
 

gcc/ada/sem_aggr.adb

@@ -1823,6 +1823,9 @@ package body Sem_Aggr is
             --  Used to keep track of the number of discrete choices in the
             --  current association.
 
+            Errors_Posted_On_Choices : Boolean := False;
+            --  Keeps track of whether any choices have semantic errors
+
          begin
             --  STEP 2 (A): Check discrete choices validity
 
@@ -1867,6 +1870,14 @@ package body Sem_Aggr is
                      Check_Unset_Reference (Choice);
                      Check_Non_Static_Context (Choice);
 
+                     --  If semantic errors were posted on the choice, then
+                     --  record that for possible early return from later
+                     --  processing (see handling of enumeration choices).
+
+                     if Error_Posted (Choice) then
+                        Errors_Posted_On_Choices := True;
+                     end if;
+
                      --  Do not range check a choice. This check is redundant
                      --  since this test is already done when we check that the
                      --  bounds of the array aggregate are within range.
@@ -2144,13 +2155,12 @@ package body Sem_Aggr is
                     and then Compile_Time_Known_Value (Choices_Low)
                     and then Compile_Time_Known_Value (Choices_High)
                   then
-                     --  If the bounds have semantic errors, do not attempt
-                     --  further resolution to prevent cascaded errors.
+                     --  If any of the expressions or range bounds in choices
+                     --  have semantic errors, then do not attempt further
+                     --  resolution, to prevent cascaded errors.
 
-                     if Error_Posted (Choices_Low)
-                       or else Error_Posted (Choices_High)
-                     then
-                        return False;
+                     if Errors_Posted_On_Choices then
+                        return Failure;
                      end if;
 
                      declare

gcc/ada/sem_ch3.adb

@@ -8298,7 +8298,9 @@ package body Sem_Ch3 is
                --  the point of instantiation, we want to find the discriminant
                --  that corresponds to D in Rec, i.e. X.
 
-               if Present (Original_Discriminant (Id)) then
+               if Present (Original_Discriminant (Id))
+                 and then In_Instance
+               then
                   Discr := Find_Corresponding_Discriminant (Id, T);
                   Found := True;
 

gcc/ada/sem_ch4.adb

@@ -3754,6 +3754,7 @@ package body Sem_Ch4 is
       --  be done transitively, so note the new original discriminant.
 
       if Nkind (Sel) = N_Identifier
+        and then In_Instance
         and then Present (Original_Discriminant (Sel))
       then
          Comp := Find_Corresponding_Discriminant (Sel, Prefix_Type);

gcc/ada/sem_res.adb

@@ -9873,29 +9873,49 @@ package body Sem_Res is
          Set_String_Literal_Low_Bound (Subtype_Id, Low_Bound);
 
       else
-         Set_String_Literal_Low_Bound
-           (Subtype_Id, Make_Integer_Literal (Loc, 1));
-         Set_Etype (String_Literal_Low_Bound (Subtype_Id), Standard_Positive);
-
-         --  Build bona fide subtype for the string, and wrap it in an
-         --  unchecked conversion, because the backend expects the
-         --  String_Literal_Subtype to have a static lower bound.
+         --  If the lower bound is not static we create a range for the string
+         --  literal, using the index type and the known length of the literal.
+         --  The index type is not necessarily Positive, so the upper bound is
+         --  computed as  T'Val (T'Pos (Low_Bound) + L - 1)
 
          declare
             Index_List    : constant List_Id    := New_List;
             Index_Type    : constant Entity_Id := Etype (First_Index (Typ));
             High_Bound    : constant Node_Id :=
-                               Make_Op_Add (Loc,
-                                  Left_Opnd => New_Copy_Tree (Low_Bound),
-                                  Right_Opnd =>
-                                    Make_Integer_Literal (Loc,
-                                      String_Length (Strval (N)) - 1));
+              Make_Attribute_Reference (Loc,
+                Attribute_Name => Name_Val,
+                Prefix => New_Occurrence_Of (Index_Type, Loc),
+                Expressions =>
+                New_List (
+                  Make_Op_Add (Loc,
+                    Left_Opnd =>
+                      Make_Attribute_Reference (Loc,
+                        Attribute_Name => Name_Pos,
+                        Prefix => New_Occurrence_Of (Index_Type, Loc),
+                        Expressions => New_List (New_Copy_Tree (Low_Bound))),
+                      Right_Opnd =>
+                            Make_Integer_Literal (Loc,
+                              String_Length (Strval (N)) - 1))));
+
             Array_Subtype : Entity_Id;
             Index_Subtype : Entity_Id;
             Drange        : Node_Id;
             Index         : Node_Id;
 
          begin
+            Set_String_Literal_Low_Bound
+              (Subtype_Id,
+               Make_Attribute_Reference (Loc,
+                 Attribute_Name => Name_First,
+                 Prefix         =>
+                   New_Occurrence_Of (Base_Type (Index_Type), Loc)));
+            Set_Etype (String_Literal_Low_Bound (Subtype_Id), Index_Type);
+            Analyze_And_Resolve (String_Literal_Low_Bound (Subtype_Id));
+
+            --  Build bona fide subtype for the string, and wrap it in an
+            --  unchecked conversion, because the backend expects the
+            --  String_Literal_Subtype to have a static lower bound.
+
             Index_Subtype :=
               Create_Itype (Subtype_Kind (Ekind (Index_Type)), N);
             Drange := Make_Range (Loc, New_Copy_Tree (Low_Bound), High_Bound);