freeze.adb (Check_Component_Storage_Order): Fix enforcement of nesting rules for...

2014-07-18  Thomas Quinot  <quinot@adacore.com>

	* freeze.adb (Check_Component_Storage_Order): Fix enforcement
	of nesting rules for composites with different SSOs.

2014-07-18  Thomas Quinot  <quinot@adacore.com>

	* par_sco.adb (Is_Logical_Operator): An If_Expression is not
	a proper logical operator.
	(Has_Decision): An If_Expression indicates the presence of a decision
	although it is not a logical operator.

From-SVN: r212793

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 77c7a7f8c6c59e395ea3f6bfd5c22477209c5632..5e3b31e1d21c792cd51d8c9d18ef3cacb3526a6f 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,15 @@
+2014-07-18  Thomas Quinot  <quinot@adacore.com>
+
+       * freeze.adb (Check_Component_Storage_Order): Fix enforcement
+       of nesting rules for composites with different SSOs.
+
+2014-07-18  Thomas Quinot  <quinot@adacore.com>
+
+       * par_sco.adb (Is_Logical_Operator): An If_Expression is not
+       a proper logical operator.
+       (Has_Decision): An If_Expression indicates the presence of a decision
+       although it is not a logical operator.
+
 2014-07-18  Robert Dewar  <dewar@adacore.com>
 
        * gnat_ugn.texi: Remove note that -gnatR not allowed with -gnatc.

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 84914106097b043a2e1cfc64f46598c96ce8ff72..ab0334e6b87a778fed1687a1aa2e0a1fa2139cdb 100644 (file)
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -1086,7 +1086,7 @@ package body Freeze is
       Err_Node  : Node_Id;
 
       Comp_Byte_Aligned : Boolean;
-      --  Set True for the record case, when Comp starts on a byte boundary
+      --  Set for the record case, True if Comp starts on a byte boundary
       --  (in which case it is allowed to have different storage order).
 
       Comp_SSO_Differs  : Boolean;
@@ -1095,6 +1095,20 @@ package body Freeze is
 
       Component_Aliased : Boolean;
 
+      function Is_Packed_Array (T : Entity_Id) return Boolean;
+      --  True for a packed array type
+
+      ---------------------
+      -- Is_Packed_Array --
+      ---------------------
+
+      function Is_Packed_Array (T : Entity_Id) return Boolean is
+      begin
+         return Is_Array_Type (T) and then Is_Packed (T);
+      end Is_Packed_Array;
+
+   --  Start of processing for Check_Component_Storage_Order
+
    begin
       --  Record case
 
@@ -1107,10 +1121,18 @@ package body Freeze is
             Component_Aliased := False;
 
          else
-            Comp_Byte_Aligned :=
-              Present (Component_Clause (Comp))
-                and then
-                  Normalized_First_Bit (Comp) mod System_Storage_Unit = 0;
+            --  If a component clause is present, check whether component
+            --  starts on a storage element boundary. Otherwise conservatively
+            --  assume it does so only in the case where the record is not
+            --  packed.
+
+            if Present (Component_Clause (Comp)) then
+               Comp_Byte_Aligned :=
+                 Normalized_First_Bit (Comp) mod System_Storage_Unit = 0;
+            else
+               Comp_Byte_Aligned := not Is_Packed (Encl_Type);
+            end if;
+
             Component_Aliased := Is_Aliased (Comp);
          end if;
 
@@ -1120,7 +1142,6 @@ package body Freeze is
          Err_Node  := Encl_Type;
          Comp_Type := Component_Type (Encl_Type);
 
-         Comp_Byte_Aligned := False;
          Component_Aliased := Has_Aliased_Components (Encl_Type);
       end if;
 
@@ -1167,14 +1188,23 @@ package body Freeze is
             --  Reject if component is a packed array, as it may be represented
             --  as a scalar internally.
 
-            if Is_Packed (Comp_Type) then
+            if Is_Packed_Array (Comp_Type) then
                Error_Msg_N
                  ("type of packed component must have same scalar "
                   & "storage order as enclosing composite", Err_Node);
 
+            --  Reject if composite is a packed array, as it may be rewritten
+            --  into an array of scalars.
+
+            elsif Is_Packed_Array (Encl_Type) then
+               Error_Msg_N ("type of packed array must have same scalar "
+                  & "storage order as component", Err_Node);
+
             --  Reject if not byte aligned
 
-            elsif not Comp_Byte_Aligned then
+            elsif Is_Record_Type (Encl_Type)
+                    and then not Comp_Byte_Aligned
+            then
                Error_Msg_N
                  ("type of non-byte-aligned component must have same scalar "
                   & "storage order as enclosing composite", Err_Node);

diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb
index 0f923ca2c394a5f1c8cd63b3afee25d951692857..215a81a9116d3bc9cca712ef079d675c8becb2cf 100644 (file)
--- a/gcc/ada/par_sco.adb
+++ b/gcc/ada/par_sco.adb
@@ -100,10 +100,10 @@ package body Par_SCO is
    --  contains a logical operator in its subtree).
 
    function Is_Logical_Operator (N : Node_Id) return Boolean;
-   --  N is the node for a subexpression. This procedure just tests N to see
-   --  if it is a logical operator (including short circuit conditions, but
-   --  excluding OR and AND) and returns True if so. It also returns True for
-   --  an if expression. False in all other cases, no other processing is done.
+   --  N is the node for a subexpression. This procedure determines whether N
+   --  a logical operator (including short circuit conditions, but excluding
+   --  OR and AND) and returns True if so. Note that in cases where True is
+   --  returned, callers assume Nkind (N) in N_Op.
 
    function To_Source_Location (S : Source_Ptr) return Source_Location;
    --  Converts Source_Ptr value to Source_Location (line/col) format
@@ -307,6 +307,9 @@ package body Par_SCO is
    function Has_Decision (N : Node_Id) return Boolean is
 
       function Check_Node (N : Node_Id) return Traverse_Result;
+      --  Determine if Nkind (N) indicates the presence of a decision (i.e.
+      --  N is a logical operator -- a decision in itelsf -- or an
+      --  IF-expression -- whose Condition attribute is a decision).
 
       ----------------
       -- Check_Node --
@@ -314,7 +317,7 @@ package body Par_SCO is
 
       function Check_Node (N : Node_Id) return Traverse_Result is
       begin
-         if Is_Logical_Operator (N) then
+         if Is_Logical_Operator (N) or else Nkind (N) = N_If_Expression then
             return Abandon;
          else
             return OK;
@@ -346,7 +349,8 @@ package body Par_SCO is
    begin
       SCO_Unit_Number_Table.Init;
 
-      --  Set dummy 0'th entry in place for sort
+      --  The SCO_Unit_Number_Table entry with index 0 is intentionally set
+      --  aside to be used as temporary for sorting.
 
       SCO_Unit_Number_Table.Increment_Last;
    end Initialize;
@@ -357,7 +361,7 @@ package body Par_SCO is
 
    function Is_Logical_Operator (N : Node_Id) return Boolean is
    begin
-      return Nkind_In (N, N_Op_Not, N_And_Then, N_Or_Else, N_If_Expression);
+      return Nkind_In (N, N_Op_Not, N_And_Then, N_Or_Else);
    end Is_Logical_Operator;
 
    -----------------------
@@ -456,7 +460,8 @@ package body Par_SCO is
 
                if Nkind_In (N, N_Op_Or, N_Or_Else) then
                   C := '|';
-               else
+
+               else pragma Assert (Nkind_In (N, N_Op_And, N_And_Then));
                   C := '&';
                end if;
             end if;