2015-02-20 Robert Dewar <dewar@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 20 Feb 2015 09:08:30 +0000 (09:08 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 20 Feb 2015 09:08:30 +0000 (09:08 +0000)
* sem_res.adb: Minor reformatting.
* exp_ch9.adb (Build_Protected_Spec): Copy Aliased setting when
building spec.
* sem_ch13.adb (Analyze_Aspect_Specifications): Exclude Boolean
aspects from circuitry setting delay required to false if the
argument is an integer literal.

2015-02-20  Ed Schonberg  <schonberg@adacore.com>

* einfo.ads. einfo.adb (Partial_View_Has_Unknown_Discr):  New flag
on type entities, to enforce AI12-0133: default initialization
of types whose partial view has unknown discriminants does not
get an invariant check, because clients of the unit can never
declare objects of such types.
* sem_ch3.adb (Find_Type_Name); Set new flag
Partial_View_Has_Unknown_Discr when needed.
* exp_ch3.adb (Expand_N_Object_Declaration): Use flag to suppress
generation of invariant call on default-initialized object.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@220836 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/einfo.adb
gcc/ada/einfo.ads
gcc/ada/exp_ch3.adb
gcc/ada/exp_ch9.adb
gcc/ada/sem_ch13.adb
gcc/ada/sem_ch3.adb
gcc/ada/sem_res.adb

index 874779e..bcc6d85 100644 (file)
@@ -1,3 +1,24 @@
+2015-02-20  Robert Dewar  <dewar@adacore.com>
+
+       * sem_res.adb: Minor reformatting.
+       * exp_ch9.adb (Build_Protected_Spec): Copy Aliased setting when
+       building spec.
+       * sem_ch13.adb (Analyze_Aspect_Specifications): Exclude Boolean
+       aspects from circuitry setting delay required to false if the
+       argument is an integer literal.
+
+2015-02-20  Ed Schonberg  <schonberg@adacore.com>
+
+       * einfo.ads. einfo.adb (Partial_View_Has_Unknown_Discr):  New flag
+       on type entities, to enforce AI12-0133: default initialization
+       of types whose partial view has unknown discriminants does not
+       get an invariant check, because clients of the unit can never
+       declare objects of such types.
+       * sem_ch3.adb (Find_Type_Name); Set new flag
+       Partial_View_Has_Unknown_Discr when needed.
+       * exp_ch3.adb (Expand_N_Object_Declaration): Use flag to suppress
+       generation of invariant call on default-initialized object.
+
 2015-02-08  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gcc-interface/decl.c (gnat_to_gnu_param): Do not strip the padding
index cfed66f..35c8c9f 100644 (file)
@@ -576,8 +576,7 @@ package body Einfo is
    --    Is_Checked_Ghost_Entity         Flag277
    --    Is_Ignored_Ghost_Entity         Flag278
    --    Contains_Ignored_Ghost_Code     Flag279
-
-   --    (unused)                        Flag280
+   --    Partial_View_Has_Unknown_Discr  Flag280
 
    --    (unused)                        Flag281
    --    (unused)                        Flag282
@@ -2739,6 +2738,12 @@ package body Einfo is
       return Elist9 (Id);
    end Part_Of_Constituents;
 
+   function Partial_View_Has_Unknown_Discr (Id : E) return B is
+   begin
+      pragma Assert (Is_Type (Id));
+      return Flag280 (Id);
+   end Partial_View_Has_Unknown_Discr;
+
    function Pending_Access_Types (Id : E) return L is
    begin
       pragma Assert (Is_Type (Id));
@@ -5632,6 +5637,12 @@ package body Einfo is
       Set_Elist9 (Id, V);
    end Set_Part_Of_Constituents;
 
+   procedure Set_Partial_View_Has_Unknown_Discr (Id : E; V : B := True) is
+   begin
+      pragma Assert (Is_Type (Id));
+      Set_Flag280 (Id, V);
+   end Set_Partial_View_Has_Unknown_Discr;
+
    procedure Set_Pending_Access_Types (Id : E; V : L) is
    begin
       pragma Assert (Is_Type (Id));
index ae714da..85a7931 100644 (file)
@@ -3578,6 +3578,11 @@ package Einfo is
 --       Present in abstract state entities. Contains all constituents that are
 --       subject to indicator Part_Of (both aspect and option variants).
 
+--    Partial_View_Has_Unknown_Discr (Flag280)
+--       Present on types entities. Indicates that the partial view of a type
+--       has unknown discriminants. A default initialization of an object of
+--       the type does not require an invariant check (AI12-0133).
+
 --    Pending_Access_Types (Elist15)
 --       Defined in all types. Set for incomplete, private, Taft-amendment
 --       types, and their corresponding full views. This list contains all
@@ -5358,6 +5363,7 @@ package Einfo is
    --    Must_Have_Preelab_Init              (Flag208)
    --    Optimize_Alignment_Space            (Flag241)
    --    Optimize_Alignment_Time             (Flag242)
+   --    Partial_View_Has_Unknown_Discr      (Flag280)
    --    Size_Depends_On_Discriminant        (Flag177)
    --    Size_Known_At_Compile_Time          (Flag92)
    --    Strict_Alignment                    (Flag145)  (base type only)
@@ -6877,6 +6883,7 @@ package Einfo is
    function Packed_Array_Impl_Type              (Id : E) return E;
    function Parent_Subtype                      (Id : E) return E;
    function Part_Of_Constituents                (Id : E) return L;
+   function Partial_View_Has_Unknown_Discr      (Id : E) return B;
    function Pending_Access_Types                (Id : E) return L;
    function Postcondition_Proc                  (Id : E) return E;
    function Prival                              (Id : E) return E;
@@ -7524,6 +7531,7 @@ package Einfo is
    procedure Set_Packed_Array_Impl_Type          (Id : E; V : E);
    procedure Set_Parent_Subtype                  (Id : E; V : E);
    procedure Set_Part_Of_Constituents            (Id : E; V : L);
+   procedure Set_Partial_View_Has_Unknown_Discr  (Id : E; V : B := True);
    procedure Set_Pending_Access_Types            (Id : E; V : L);
    procedure Set_Postcondition_Proc              (Id : E; V : E);
    procedure Set_Prival                          (Id : E; V : E);
@@ -8323,6 +8331,7 @@ package Einfo is
    pragma Inline (Parameter_Mode);
    pragma Inline (Parent_Subtype);
    pragma Inline (Part_Of_Constituents);
+   pragma Inline (Partial_View_Has_Unknown_Discr);
    pragma Inline (Pending_Access_Types);
    pragma Inline (Postcondition_Proc);
    pragma Inline (Prival);
@@ -8769,6 +8778,7 @@ package Einfo is
    pragma Inline (Set_Packed_Array_Impl_Type);
    pragma Inline (Set_Parent_Subtype);
    pragma Inline (Set_Part_Of_Constituents);
+   pragma Inline (Partial_View_Has_Unknown_Discr);
    pragma Inline (Set_Pending_Access_Types);
    pragma Inline (Set_Postcondition_Proc);
    pragma Inline (Set_Prival);
index a8e4137..095e233 100644 (file)
@@ -5503,10 +5503,13 @@ package body Exp_Ch3 is
                Ensure_Freeze_Node (Def_Id);
                Set_Has_Delayed_Freeze (Def_Id);
                Set_Is_Frozen (Def_Id, False);
-               Append_Freeze_Action (Def_Id,
-                 Make_Invariant_Call (New_Occurrence_Of (Def_Id, Loc)));
 
-            else
+               if not Partial_View_Has_Unknown_Discr (Typ) then
+                  Append_Freeze_Action (Def_Id,
+                    Make_Invariant_Call (New_Occurrence_Of (Def_Id, Loc)));
+               end if;
+
+            elsif not Partial_View_Has_Unknown_Discr (Typ) then
                Insert_After (N,
                  Make_Invariant_Call (New_Occurrence_Of (Def_Id, Loc)));
             end if;
index 7f26a8c..361952b 100644 (file)
@@ -4032,8 +4032,9 @@ package body Exp_Ch9 is
            Make_Parameter_Specification (Loc,
              Defining_Identifier =>
                Make_Defining_Identifier (Sloc (Formal), Chars (Formal)),
-             In_Present          => In_Present (Parent (Formal)),
-             Out_Present         => Out_Present (Parent (Formal)),
+             Aliased_Present     => Aliased_Present (Parent (Formal)),
+             In_Present          => In_Present      (Parent (Formal)),
+             Out_Present         => Out_Present     (Parent (Formal)),
              Parameter_Type      => New_Occurrence_Of (Etype (Formal), Loc));
 
          if Unprotected then
index 7d0ca02..56aee5a 100644 (file)
@@ -1621,14 +1621,25 @@ package body Sem_Ch13 is
                   --  do not delay, since we know the value cannot change.
                   --  This optimization catches most rep clause cases.
 
-               if (Present (Expr) and then Nkind (Expr) = N_Integer_Literal)
-                 or else (A_Id in Boolean_Aspects and then No (Expr))
-               then
-                  Delay_Required := False;
-               else
-                  Delay_Required := True;
-                  Set_Has_Delayed_Rep_Aspects (E);
-               end if;
+                  --  For Boolean aspects, don't delay if no expression
+
+                  if A_Id in Boolean_Aspects and then No (Expr) then
+                     Delay_Required := False;
+
+                  --  For non-Boolean aspects, don't delay if integer literal
+
+                  elsif A_Id not in Boolean_Aspects
+                    and then Present (Expr)
+                    and then Nkind (Expr) = N_Integer_Literal
+                  then
+                     Delay_Required := False;
+
+                  --  All other cases are delayed
+
+                  else
+                     Delay_Required := True;
+                     Set_Has_Delayed_Rep_Aspects (E);
+                  end if;
             end case;
 
             --  Processing based on specific aspect
index 5aa5fe0..a017734 100644 (file)
@@ -16459,6 +16459,13 @@ package body Sem_Ch3 is
             Set_Has_Private_Declaration (Prev);
             Set_Has_Private_Declaration (Id);
 
+            --  AI12-0133 : indicate whether we have a partial view with
+            --  unknown discriminants, in which case initialization of objects
+            --  of the type do not receive an invariant check.
+
+            Set_Partial_View_Has_Unknown_Discr
+              (Prev, Has_Unknown_Discriminants (Id));
+
             --  Preserve aspect and iterator flags that may have been set on
             --  the partial view.
 
index b51a280..851e0a6 100644 (file)
@@ -3091,9 +3091,9 @@ package body Sem_Res is
       --  This must be determined before the actual is resolved and expanded
       --  because if needed the transient scope must be introduced earlier.
 
-      ------------------------------
-      --  Check_Aliased_Parameter --
-      ------------------------------
+      -----------------------------
+      -- Check_Aliased_Parameter --
+      -----------------------------
 
       procedure Check_Aliased_Parameter is
          Nominal_Subt : Entity_Id;