[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Wed, 3 Aug 2011 08:02:56 +0000 (10:02 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Wed, 3 Aug 2011 08:02:56 +0000 (10:02 +0200)
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
gcc/ada/einfo.ads
gcc/ada/exp_ch13.adb
gcc/ada/exp_disp.adb
gcc/ada/gnat_rm.texi
gcc/ada/gnat_ugn.texi
gcc/ada/sem_aggr.adb
gcc/ada/sem_ch3.adb
gcc/ada/sem_ch4.adb
gcc/ada/sem_res.adb

index 47ec9bf44f76003e6748b10d6b39af5e7227024b..2ce9de1811d90e68764a321582ae321b05b13ac6 100644 (file)
@@ -1,3 +1,42 @@
+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.
index d666b5f85fbeee1e30d450b7a97fa031b23c4fb2..993094e19c709acc6d50f96128bc321fe2de8907 100644 (file)
@@ -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
index 39b32cec46dfcc8aaf0a56f8bb9493cf0de1263b..dbf664c5bad2395520775b5f770a15d93bd2463b 100644 (file)
@@ -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
index 85abeafdb139a606549acf6a8466381c98baf5c6..69159632d50ad352203e6931cadfb8fef1bc43e7 100644 (file)
@@ -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
index cc3435b05815714e46841f8544df4ecbf3347373..670c23cf031a9da96c468f1106141d4ea4411a6c 100644 (file)
@@ -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
index 0174bd71bd484a651fe550532b85dfc0513360d5..ba83f787f5df695f54ffdecdaf0d92097ab4ba82 100644 (file)
@@ -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
 
index 59374c203829df0e6dbf3b2c542df184dd1ea1c8..63a02e1d2477ff5f7b585310666849e95f288ba7 100644 (file)
@@ -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
index 6a1e3e940ea8fb4efdd65104a1779abb9229bd71..6441cfa739656a6de5d41fec1ddd2677778ed53a 100644 (file)
@@ -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;
 
index ba631fbffc37e7eb438f23277d22edcce4e4419e..82a6161533d7279f2dca3aeb757007ae4ccdffb0 100644 (file)
@@ -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);
index 840537d83775f32bdafadb6cd5f9957d1a67f24d..7d51803724275f0c0ce5e7fd80d5fed969e4f663 100644 (file)
@@ -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);