[multiple changes]

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

	* gnat_rm.texi (Scalar_Storage_Order): Update documentation.

2014-01-21  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Set_Instance_Env): In Ada 2012 mode, preserve
	the value of Assertions_Enabled flag when compiling an instance of
	an internal unit. This facilitates the use of pre/postconditions
	in generic internal units, such as the new elementary function
	libraries.

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

	* exp_aggr.adb: Minor reformatting.
	* sem_attr.adb: Minor reformatting.
	* sem_res.adb: Minor comment addition.
	* einfo.adb: Minor comment updates.
	* freeze.adb: Minor reformatting and code reorganization.

2014-01-21  Ed Schonberg  <schonberg@adacore.com>

	* par-ch4.adb (P_If_Expression): Handle more gracefully an
	elsif clause that does not have an else part.

From-SVN: r206891

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d33381a..a09a80e 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,28 @@
+2014-01-21  Thomas Quinot  <quinot@adacore.com>
+
+       * gnat_rm.texi (Scalar_Storage_Order): Update documentation.
+
+2014-01-21  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch12.adb (Set_Instance_Env): In Ada 2012 mode, preserve
+       the value of Assertions_Enabled flag when compiling an instance of
+       an internal unit. This facilitates the use of pre/postconditions
+       in generic internal units, such as the new elementary function
+       libraries.
+
+2014-01-21  Robert Dewar  <dewar@adacore.com>
+
+       * exp_aggr.adb: Minor reformatting.
+       * sem_attr.adb: Minor reformatting.
+       * sem_res.adb: Minor comment addition.
+       * einfo.adb: Minor comment updates.
+       * freeze.adb: Minor reformatting and code reorganization.
+
+2014-01-21  Ed Schonberg  <schonberg@adacore.com>
+
+       * par-ch4.adb (P_If_Expression): Handle more gracefully an
+       elsif clause that does not have an else part.
+
 2014-01-21  Robert Dewar  <dewar@adacore.com>
 
        * checks.adb, sem_util.ads, sem_ch4.adb: Minor reformatting.

diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 65d54bb..88643b8 100644 (file)
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -264,8 +264,6 @@ package body Einfo is
    --  sense for them to be set true for certain subsets of entity kinds. See
    --  the spec of Einfo for further details.
 
-   --  Note: Flag1-Flag3 are not used, for historical reasons
-
    --    Is_Frozen                       Flag4
    --    Has_Discriminants               Flag5
    --    Is_Dispatching_Operation        Flag6
@@ -556,6 +554,10 @@ package body Einfo is
    --    SPARK_Pragma_Inherited          Flag265
    --    SPARK_Aux_Pragma_Inherited      Flag266
 
+   --    (unused)                        Flag1
+   --    (unused)                        Flag2
+   --    (unused)                        Flag3
+
    --    (unused)                        Flag267
    --    (unused)                        Flag268
    --    (unused)                        Flag269

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 6147001..6c5104b 100644 (file)
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -3190,7 +3190,7 @@ package body Exp_Aggr is
             Insert_Action (N,
               Make_Raise_Constraint_Error (Loc,
                 Condition => Cond,
-                Reason => CE_Discriminant_Check_Failed));
+                Reason    => CE_Discriminant_Check_Failed));
          end if;
 
          return True;

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 6885625..310511f 100644 (file)
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -233,7 +233,7 @@ package body Freeze is
 
       --  Note that it is legal for a renaming_as_body to rename an intrinsic
       --  subprogram, as long as the renaming occurs before the new entity
-      --  is frozen. See RM 8.5.4 (5).
+      --  is frozen (RM 8.5.4 (5)).
 
       if Nkind (Body_Decl) = N_Subprogram_Renaming_Declaration
         and then Is_Entity_Name (Name (Body_Decl))
@@ -1174,7 +1174,6 @@ package body Freeze is
                Error_Msg_N
                  ("type of non-byte-aligned component must have same scalar "
                   & "storage order as enclosing composite", Err_Node);
-
             end if;
          end if;
 
@@ -1257,9 +1256,7 @@ package body Freeze is
 
       --  Do not attempt to analyze case where range was in error
 
-      if No (Scalar_Range (E))
-        or else Error_Posted (Scalar_Range (E))
-      then
+      if No (Scalar_Range (E)) or else Error_Posted (Scalar_Range (E)) then
          return;
       end if;
 
@@ -1284,7 +1281,6 @@ package body Freeze is
          Lo_Bound := Type_Low_Bound (Ancestor);
 
          if Compile_Time_Known_Value (Lo_Bound) then
-
             if Expr_Rep_Value (Lo_Bound) >= 0 then
                Set_Is_Unsigned_Type (E, True);
             end if;
@@ -1452,10 +1448,8 @@ package body Freeze is
                end if;
 
             elsif Ekind (E) in Task_Kind
-              and then
-                (Nkind (Parent (E)) = N_Task_Type_Declaration
-                   or else
-                 Nkind (Parent (E)) = N_Single_Task_Declaration)
+              and then Nkind_In (Parent (E), N_Task_Type_Declaration,
+                                             N_Single_Task_Declaration)
             then
                Push_Scope (E);
                Freeze_All (First_Entity (E), After);
@@ -1626,10 +1620,8 @@ package body Freeze is
             end if;
 
          elsif Ekind (E) in Task_Kind
-           and then
-             (Nkind (Parent (E)) = N_Task_Type_Declaration
-                or else
-              Nkind (Parent (E)) = N_Single_Task_Declaration)
+           and then Nkind_In (Parent (E), N_Task_Type_Declaration,
+                                          N_Single_Task_Declaration)
          then
             declare
                Ent : Entity_Id;
@@ -2075,11 +2067,12 @@ package body Freeze is
             --  If packing was requested or if the component size was
             --  set explicitly, then see if bit packing is required. This
             --  processing is only done for base types, since all of the
-            --  representation aspects involved are type-related. This is not
-            --  just an optimization, if we start processing the subtypes, they
-            --  interfere with the settings on the base type (this is because
-            --  Is_Packed has a slightly different meaning before and after
-            --  freezing).
+            --  representation aspects involved are type-related.
+
+            --  This is not just an optimization, if we start processing the
+            --  subtypes, they interfere with the settings on the base type
+            --  (this is because Is_Packed has a slightly different meaning
+            --  before and after freezing).
 
             declare
                Csiz : Uint;
@@ -2240,10 +2233,11 @@ package body Freeze is
             --  Check for Atomic_Components or Aliased with unsuitable packing
             --  or explicit component size clause given.
 
-            if (Has_Atomic_Components (Arr)
-                 or else Has_Aliased_Components (Arr))
-              and then (Has_Component_Size_Clause (Arr)
-                         or else Is_Packed (Arr))
+            if (Has_Atomic_Components  (Arr)
+                  or else
+                Has_Aliased_Components (Arr))
+              and then
+                (Has_Component_Size_Clause (Arr) or else Is_Packed (Arr))
             then
                Alias_Atomic_Check : declare
 
@@ -2343,19 +2337,13 @@ package body Freeze is
                   & "accessible by separate tasks??", Clause, Arr);
 
                if Has_Component_Size_Clause (Arr) then
-                  Error_Msg_Sloc :=
-                    Sloc
-                      (Get_Attribute_Definition_Clause
-                           (FS, Attribute_Component_Size));
-                  Error_Msg_N
-                    ("\because of component size clause#??",
-                     Clause);
+                  Error_Msg_Sloc := Sloc (Get_Attribute_Definition_Clause
+                                           (FS, Attribute_Component_Size));
+                  Error_Msg_N ("\because of component size clause#??", Clause);
 
                elsif Has_Pragma_Pack (Arr) then
-                  Error_Msg_Sloc :=
-                    Sloc (Get_Rep_Pragma (FS, Name_Pack));
-                  Error_Msg_N
-                    ("\because of pragma Pack#??", Clause);
+                  Error_Msg_Sloc := Sloc (Get_Rep_Pragma (FS, Name_Pack));
+                  Error_Msg_N ("\because of pragma Pack#??", Clause);
                end if;
             end if;
 
@@ -2433,8 +2421,7 @@ package body Freeze is
                   end loop;
 
                   if Elmts > Intval (High_Bound
-                                     (Scalar_Range
-                                        (Standard_Integer))) + 1
+                                       (Scalar_Range (Standard_Integer))) + 1
                   then
                      Error_Msg_N
                        ("bit packed array type may not have "
@@ -2780,7 +2767,7 @@ package body Freeze is
 
                   if Is_Itype (Etype (Comp))
                     and then Is_Record_Type (Underlying_Type
-                                             (Scope (Etype (Comp))))
+                                               (Scope (Etype (Comp))))
                   then
                      Undelay_Type (Etype (Comp));
                   end if;
@@ -2820,21 +2807,25 @@ package body Freeze is
                   --  Check for error of component clause given for variable
                   --  sized type. We have to delay this test till this point,
                   --  since the component type has to be frozen for us to know
-                  --  if it is variable length. We omit this test in a generic
-                  --  context, it will be applied at instantiation time.
-
-                  --  We also omit this test in CodePeer mode, since we do not
-                  --  have sufficient info on size and representation clauses.
+                  --  if it is variable length.
 
                   if Present (CC) then
                      Placed_Component := True;
 
+                     --  We omit this test in a generic context, it will be
+                     --  applied at instantiation time.
+
                      if Inside_A_Generic then
                         null;
 
+                     --  Also omit this test in CodePeer mode, since we do not
+                     --  have sufficient info on size and rep clauses.
+
                      elsif CodePeer_Mode then
                         null;
 
+                     --  Do the check
+
                      elsif not
                        Size_Known_At_Compile_Time
                          (Underlying_Type (Etype (Comp)))
@@ -3011,11 +3002,11 @@ package body Freeze is
               and then Present (Expression (Parent (Comp)))
               and then Nkind (Expression (Parent (Comp))) = N_Aggregate
               and then Is_Fully_Defined
-                 (Designated_Type (Component_Type (Etype (Comp))))
+                         (Designated_Type (Component_Type (Etype (Comp))))
             then
                Freeze_And_Append
                  (Designated_Type
-                   (Component_Type (Etype (Comp))), N, Result);
+                    (Component_Type (Etype (Comp))), N, Result);
             end if;
 
             Prev := Comp;
@@ -3816,9 +3807,9 @@ package body Freeze is
 
                         elsif (Is_Tagged_Type (R_Type)
                                 or else (Is_Access_Type (R_Type)
-                                           and then
-                                             Is_Tagged_Type
-                                               (Designated_Type (R_Type))))
+                                          and then
+                                            Is_Tagged_Type
+                                              (Designated_Type (R_Type))))
                           and then Convention (E) = Convention_C
                           and then not Has_Warnings_Off (E)
                           and then not Has_Warnings_Off (R_Type)
@@ -4118,13 +4109,8 @@ package body Freeze is
 
             --  Remaining step is to layout objects
 
-            if Ekind (E) = E_Variable
-                 or else
-               Ekind (E) = E_Constant
-                 or else
-               Ekind (E) = E_Loop_Parameter
-                 or else
-               Is_Formal (E)
+            if Ekind_In (E, E_Variable, E_Constant, E_Loop_Parameter)
+              or else Is_Formal (E)
             then
                Layout_Object (E);
             end if;
@@ -4449,8 +4435,7 @@ package body Freeze is
 
          elsif Is_Concurrent_Type (E) then
             if Present (Corresponding_Record_Type (E)) then
-               Freeze_And_Append
-                 (Corresponding_Record_Type (E), N, Result);
+               Freeze_And_Append (Corresponding_Record_Type (E), N, Result);
             end if;
 
             Comp := First_Entity (E);
@@ -4596,9 +4581,7 @@ package body Freeze is
             --  amendment type, so diagnosis is at the point of use and the
             --  type might be frozen later.
 
-            elsif E /= Base_Type (E)
-              or else Is_Derived_Type (E)
-            then
+            elsif E /= Base_Type (E) or else Is_Derived_Type (E) then
                null;
 
             else
@@ -4813,8 +4796,7 @@ package body Freeze is
                --  be an array type, or a nonlimited record type).
 
                if Has_Private_Declaration (E) then
-                  if (not Is_Record_Type (E)
-                       or else not Is_Limited_View (E))
+                  if (not Is_Record_Type (E) or else not Is_Limited_View (E))
                     and then not Is_Private_Type (E)
                   then
                      Error_Msg_Name_1 := Name_Simple_Storage_Pool_Type;
@@ -4845,7 +4827,8 @@ package body Freeze is
                   --  Upon return, Pool_Op_Formal will be updated to the next
                   --  formal, if any.
 
-                  procedure Validate_Simple_Pool_Operation (Op_Name : Name_Id);
+                  procedure Validate_Simple_Pool_Operation
+                    (Op_Name : Name_Id);
                   --  Search for and validate a simple pool operation with the
                   --  name Op_Name. If the name is Allocate, then there must be
                   --  exactly one such primitive operation for the simple pool
@@ -6784,18 +6767,16 @@ package body Freeze is
             --  directly.
 
             if Nkind (Dcopy) = N_Identifier
-              or else Nkind (Dcopy) = N_Expanded_Name
-              or else Nkind (Dcopy) = N_Integer_Literal
+              or else Nkind_In (Dcopy, N_Expanded_Name,
+                                       N_Integer_Literal,
+                                       N_Character_Literal,
+                                       N_String_Literal)
               or else (Nkind (Dcopy) = N_Real_Literal
                         and then not Vax_Float (Etype (Dcopy)))
-              or else Nkind (Dcopy) = N_Character_Literal
-              or else Nkind (Dcopy) = N_String_Literal
-              or else Known_Null (Dcopy)
               or else (Nkind (Dcopy) = N_Attribute_Reference
-                        and then
-                       Attribute_Name (Dcopy) = Name_Null_Parameter)
+                        and then Attribute_Name (Dcopy) = Name_Null_Parameter)
+              or else Known_Null (Dcopy)
             then
-
                --  If there is no default function, we must still do a full
                --  analyze call on the default value, to ensure that all error
                --  checks are performed, e.g. those associated with static

diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 146936c..9d270c9 100644 (file)
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -8897,8 +8897,9 @@ order as the parent type.
 
 If a component of @var{S} has itself a record or array type, then it shall also
 have a @code{Scalar_Storage_Order} attribute definition clause. In addition,
-if the component does not start on a byte boundary, then the scalar storage
-order specified for S and for the nested component type shall be identical.
+if the component is a packed array, or does not start on a byte boundary, then
+the scalar storage order specified for S and for the nested component type shall
+be identical.
 
 If @var{S} appears as the type of a record or array component, the enclosing
 record or array shall also have a @code{Scalar_Storage_Order} attribute

diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb
index 5981f01..ab66f5c 100644 (file)
--- a/gcc/ada/par-ch4.adb
+++ b/gcc/ada/par-ch4.adb
@@ -3078,6 +3078,7 @@ package body Ch4 is
    function P_If_Expression return Node_Id is
       Exprs : constant List_Id    := New_List;
       Loc   : constant Source_Ptr := Token_Ptr;
+      Cond  : Node_Id;
       Expr  : Node_Id;
       State : Saved_Scan_State;
 
@@ -3085,9 +3086,17 @@ package body Ch4 is
       Inside_If_Expression := Inside_If_Expression + 1;
       Error_Msg_Ada_2012_Feature ("|if expression", Token_Ptr);
       Scan; -- past IF or ELSIF
-      Append_To (Exprs, P_Condition);
-      TF_Then;
-      Append_To (Exprs, P_Expression);
+      Cond := P_Condition;
+
+      if Token = Tok_Then then
+         Scan;  --  past THEN
+         Append_To (Exprs, Cond);
+         Append_To (Exprs, P_Expression);
+
+      else
+         Error_Msg ("ELSIF should be ELSE", Loc);
+         return Cond;
+      end if;
 
       --  We now have scanned out IF expr THEN expr
 
@@ -3110,7 +3119,14 @@ package body Ch4 is
 
       if Token = Tok_Elsif then
          Expr := P_If_Expression;
-         Set_Is_Elsif (Expr);
+
+         if Nkind (Expr) = N_If_Expression then
+            Set_Is_Elsif (Expr);
+
+            --  Otherwise, this is an incomplete ELSIF as reported earlier,
+            --  so treat the expression as a final ELSE for better recovery.
+         end if;
+
          Append_To (Exprs, Expr);
 
       --  Scan out ELSE phrase if present

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 1b585cb..5727e6d 100644 (file)
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -9788,8 +9788,9 @@ package body Sem_Attr is
                    Object_Access_Level (P) > Deepest_Type_Access_Level (Btyp)
                  and then Attr_Id = Attribute_Access
                then
-                  --  In an instance, this is a runtime check, but one we
-                  --  know will fail, so generate an appropriate warning.
+                  --  In an instance, this is a runtime check, but one we know
+                  --  will fail, so generate an appropriate warning. As usual,
+                  --  this kind of warning is an error in SPARK mode.
 
                   if In_Instance_Body then
                      Error_Msg_Warn := SPARK_Mode /= On;

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index b59c895..6b9c5fe 100644 (file)
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -13796,6 +13796,8 @@ package body Sem_Ch12 is
      (Gen_Unit : Entity_Id;
       Act_Unit : Entity_Id)
    is
+      Assertion_Status : constant Boolean := Assertions_Enabled;
+
    begin
       --  Regardless of the current mode, predefined units are analyzed in the
       --  most current Ada mode, and earlier version Ada checks do not apply
@@ -13807,6 +13809,16 @@ package body Sem_Ch12 is
             Renamings_Included => True)
       then
          Set_Opt_Config_Switches (True, Current_Sem_Unit = Main_Unit);
+
+         --  In Ada2012 we may want to enable assertions in an instance of a
+         --  predefined unit, in which case we need to preserve the current
+         --  setting for the Assertions_Enabled flag. This will become more
+         --  critical when pre/postconditions are added to predefined units,
+         --  as is already the case for some numeric libraries.
+
+         if Ada_Version >= Ada_2012 then
+            Assertions_Enabled := Assertion_Status;
+         end if;
       end if;
 
       Current_Instantiated_Parent :=

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index c42a7fa..dbc13d3 100644 (file)
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -9069,6 +9069,8 @@ package body Sem_Res is
          T := Etype (P);
       end if;
 
+      --  Set flag for expander if discriminant check required
+
       if Has_Discriminants (T)
         and then Ekind_In (Entity (S), E_Component, E_Discriminant)
         and then Present (Original_Record_Component (Entity (S)))