[multiple changes]

2014-08-04  Ed Schonberg  <schonberg@adacore.com>

	* exp_aggr.adb (Expand_Array_Aggregate): Do not attempt expansion
	if error already detected.  We may reach this point in spite of
	previous errors when compiling with -gnatq, to force all possible
	errors (this is the usual ACATS mode).

2014-08-04  Gary Dismukes  <dismukes@adacore.com>

	* checks.adb (Generate_Range_Check): For the case of converting
	a base type with a larger range to a smaller target subtype, only
	use unchecked conversions of bounds in the range check followed
	by conversion in the case where both types are discrete. In other
	cases, convert to the target base type and save in a temporary
	followed by the range check.
	(Convert_And_Check_Range): New procedure factoring code to save
	conversion to a temporary followed by a range check (called two
	places in Generate_Range_Check).
	* exp_ch4.adb (Expand_N_Type_Conversion): Relax previous
	check-in, to generate range checks for conversions between
	any floating-point types rather than limiting it to matching
	base types.

From-SVN: r213532

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 452488a37f3cd000c399b13121ba7ead639adf1e..bcbe25ddf74790b55e0197e74442ac6c15f0e481 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,30 @@
+2014-08-04  Arnaud Charlet  <charlet@adacore.com>
+
+       * g-trasym-vms-ia64.adb, g-trasym-vms-alpha.adb: Removed.
+
+2014-08-04  Ed Schonberg  <schonberg@adacore.com>
+
+       * exp_aggr.adb (Expand_Array_Aggregate): Do not attempt expansion
+       if error already detected.  We may reach this point in spite of
+       previous errors when compiling with -gnatq, to force all possible
+       errors (this is the usual ACATS mode).
+
+2014-08-04  Gary Dismukes  <dismukes@adacore.com>
+
+       * checks.adb (Generate_Range_Check): For the case of converting
+       a base type with a larger range to a smaller target subtype, only
+       use unchecked conversions of bounds in the range check followed
+       by conversion in the case where both types are discrete. In other
+       cases, convert to the target base type and save in a temporary
+       followed by the range check.
+       (Convert_And_Check_Range): New procedure factoring code to save
+       conversion to a temporary followed by a range check (called two
+       places in Generate_Range_Check).
+       * exp_ch4.adb (Expand_N_Type_Conversion): Relax previous
+       check-in, to generate range checks for conversions between
+       any floating-point types rather than limiting it to matching
+       base types.
+
 2014-08-02  Trevor Saunders  <tsaunders@mozilla.com>
 
        * gcc-interface/trans.c: Use hash_set instead of pointer_set.

diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index bf27d4ef3a2f2b4272052f7979ad59d4d8f244f8..bab3ba7eb0a03a4d2a7dd112d7e0a369c5b00969 100644 (file)
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -6402,6 +6402,59 @@ package body Checks is
       Source_Base_Type : constant Entity_Id  := Base_Type (Source_Type);
       Target_Base_Type : constant Entity_Id  := Base_Type (Target_Type);
 
+      procedure Convert_And_Check_Range;
+      --  Convert the conversion operand to the target base type and save in
+      --  a temporary. Then check the converted value against the range of the
+      --  target subtype.
+
+      procedure Convert_And_Check_Range is
+         --  To what does the following comment belong???
+         --  We make a temporary to hold the value of the converted value
+         --  (converted to the base type), and then we will do the test against
+         --  this temporary.
+         --
+         --     Tnn : constant Target_Base_Type := Target_Base_Type (N);
+         --     [constraint_error when Tnn not in Target_Type]
+         --
+         --  The conversion itself is replaced by an occurrence of Tnn
+
+         Tnn : constant Entity_Id := Make_Temporary (Loc, 'T', N);
+
+         --  To what does the following comment belong???
+         --  Follow the conversion with the explicit range check. Note that we
+         --  suppress checks for this code, since we don't want a recursive
+         --  range check popping up.
+
+      begin
+         Insert_Actions (N, New_List (
+           Make_Object_Declaration (Loc,
+             Defining_Identifier => Tnn,
+             Object_Definition   => New_Occurrence_Of (Target_Base_Type, Loc),
+             Constant_Present    => True,
+             Expression          =>
+               Make_Type_Conversion (Loc,
+                 Subtype_Mark => New_Occurrence_Of (Target_Base_Type, Loc),
+                 Expression   => Duplicate_Subexpr (N))),
+
+           Make_Raise_Constraint_Error (Loc,
+             Condition =>
+               Make_Not_In (Loc,
+                 Left_Opnd  => New_Occurrence_Of (Tnn, Loc),
+                 Right_Opnd => New_Occurrence_Of (Target_Type, Loc)),
+             Reason => Reason)),
+           Suppress => All_Checks);
+
+         Rewrite (N, New_Occurrence_Of (Tnn, Loc));
+
+         --  Set the type of N, because the declaration for Tnn might not
+         --  be analyzed yet, as is the case if N appears within a record
+         --  declaration, as a discriminant constraint or expression.
+
+         Set_Etype (N, Target_Base_Type);
+      end Convert_And_Check_Range;
+
+   --  Start of processing for Generate_Range_Check
+
    begin
       --  First special case, if the source type is already within the range
       --  of the target type, then no check is needed (probably we should have
@@ -6500,29 +6553,44 @@ package body Checks is
          --  Insert the explicit range check. Note that we suppress checks for
          --  this code, since we don't want a recursive range check popping up.
 
-         Insert_Action (N,
-           Make_Raise_Constraint_Error (Loc,
-             Condition =>
-               Make_Not_In (Loc,
-                 Left_Opnd  => Duplicate_Subexpr (N),
+         if Is_Discrete_Type (Source_Base_Type)
+              and then
+            Is_Discrete_Type (Target_Base_Type)
+         then
+            Insert_Action (N,
+              Make_Raise_Constraint_Error (Loc,
+                Condition =>
+                  Make_Not_In (Loc,
+                    Left_Opnd  => Duplicate_Subexpr (N),
 
-                 Right_Opnd =>
-                   Make_Range (Loc,
-                     Low_Bound =>
-                       Unchecked_Convert_To (Source_Base_Type,
-                         Make_Attribute_Reference (Loc,
-                           Prefix =>
-                             New_Occurrence_Of (Target_Type, Loc),
-                           Attribute_Name => Name_First)),
-
-                     High_Bound =>
-                       Unchecked_Convert_To (Source_Base_Type,
-                         Make_Attribute_Reference (Loc,
-                           Prefix =>
-                             New_Occurrence_Of (Target_Type, Loc),
-                           Attribute_Name => Name_Last)))),
-             Reason => Reason),
-           Suppress => All_Checks);
+                    Right_Opnd =>
+                      Make_Range (Loc,
+                        Low_Bound  =>
+                          Unchecked_Convert_To (Source_Base_Type,
+                            Make_Attribute_Reference (Loc,
+                              Prefix         =>
+                                New_Occurrence_Of (Target_Type, Loc),
+                              Attribute_Name => Name_First)),
+
+                        High_Bound =>
+                          Unchecked_Convert_To (Source_Base_Type,
+                            Make_Attribute_Reference (Loc,
+                              Prefix         =>
+                                New_Occurrence_Of (Target_Type, Loc),
+                              Attribute_Name => Name_Last)))),
+                Reason    => Reason),
+              Suppress => All_Checks);
+
+         --  For conversions involving at least one type that is not discrete,
+         --  first convert to target type and then generate the range check.
+         --  This avoids problems with values that are close to a bound of the
+         --  target type that would fail a range check when done in a larger
+         --  source type before converting but would pass if converted with
+         --  rounding and then checked (such as in float-to-float conversions).
+
+         else
+            Convert_And_Check_Range;
+         end if;
 
       --  Note that at this stage we now that the Target_Base_Type is not in
       --  the range of the Source_Base_Type (since even the Target_Type itself
@@ -6533,51 +6601,7 @@ package body Checks is
       --  and then test the target result against the bounds.
 
       elsif In_Subrange_Of (Source_Type, Target_Base_Type) then
-
-         --  We make a temporary to hold the value of the converted value
-         --  (converted to the base type), and then we will do the test against
-         --  this temporary.
-
-         --     Tnn : constant Target_Base_Type := Target_Base_Type (N);
-         --     [constraint_error when Tnn not in Target_Type]
-
-         --  Then the conversion itself is replaced by an occurrence of Tnn
-
-         --  Insert the explicit range check. Note that we suppress checks for
-         --  this code, since we don't want a recursive range check popping up.
-
-         declare
-            Tnn : constant Entity_Id := Make_Temporary (Loc, 'T', N);
-
-         begin
-            Insert_Actions (N, New_List (
-              Make_Object_Declaration (Loc,
-                Defining_Identifier => Tnn,
-                Object_Definition   =>
-                  New_Occurrence_Of (Target_Base_Type, Loc),
-                Constant_Present    => True,
-                Expression          =>
-                  Make_Type_Conversion (Loc,
-                    Subtype_Mark => New_Occurrence_Of (Target_Base_Type, Loc),
-                    Expression   => Duplicate_Subexpr (N))),
-
-              Make_Raise_Constraint_Error (Loc,
-                Condition =>
-                  Make_Not_In (Loc,
-                    Left_Opnd  => New_Occurrence_Of (Tnn, Loc),
-                    Right_Opnd => New_Occurrence_Of (Target_Type, Loc)),
-
-                Reason => Reason)),
-              Suppress => All_Checks);
-
-            Rewrite (N, New_Occurrence_Of (Tnn, Loc));
-
-            --  Set the type of N, because the declaration for Tnn might not
-            --  be analyzed yet, as is the case if N appears within a record
-            --  declaration, as a discriminant constraint or expression.
-
-            Set_Etype (N, Target_Base_Type);
-         end;
+         Convert_And_Check_Range;
 
       --  At this stage, we know that we have two scalar types, which are
       --  directly convertible, and where neither scalar type has a base

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 378d66fee631f9cf164fc6fedc7a96f1e354dfd0..60838de36740ad0d343290ddd9e12537be217295 100644 (file)
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -5013,6 +5013,13 @@ package body Exp_Aggr is
                    (Return_Applies_To (Return_Statement_Entity (Parent (N))))
       then
          return;
+
+      --  Do not attempt expansion if error already detected. We may reach this
+      --  point in spite of previous errors when compiling with -gnatq, to
+      --  force all possible errors (this is the usual ACATS mode).
+
+      elsif Error_Posted (N) then
+         return;
       end if;
 
       --  If the semantic analyzer has determined that aggregate N will raise

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 0e6ea4f8fb225c90dc15a014647b0abe7b4f4a86..7123389b813e3a4f5e4f67a0e86bef222b22f832 100644 (file)
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -10844,19 +10844,19 @@ package body Exp_Ch4 is
 
       --  The only remaining step is to generate a range check if we still have
       --  a type conversion at this stage and Do_Range_Check is set. For now we
-      --  do this only for conversions of discrete types and for floating-point
-      --  conversions where the base types of source and target are the same.
+      --  do this only for conversions of discrete types and for float-to-float
+      --  conversions.
 
       if Nkind (N) = N_Type_Conversion then
 
-         --  For now we only support floating-point cases where the base types
-         --  of the target type and source expression are the same, so there's
-         --  potentially only a range check. Conversions where the source and
-         --  target have different base types are still TBD. ???
+         --  For now we only support floating-point cases where both source
+         --  and target are floating-point types. Conversions where the source
+         --  and target involve integer or fixed-point types are still TBD,
+         --  though not clear whether those can even happen at this point, due
+         --  to transformations above. ???
 
          if Is_Floating_Point_Type (Etype (N))
-           and then
-             Base_Type (Etype (N)) = Base_Type (Etype (Expression (N)))
+           and then Is_Floating_Point_Type (Etype (Expression (N)))
          then
             if Do_Range_Check (Expression (N))
               and then Is_Floating_Point_Type (Target_Type)
@@ -10865,6 +10865,8 @@ package body Exp_Ch4 is
                  (Expression (N), Target_Type, CE_Range_Check_Failed);
             end if;
 
+         --  Discrete-to-discrete conversions
+
          elsif Is_Discrete_Type (Etype (N)) then
             declare
                Expr : constant Node_Id := Expression (N);