git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

[multiple changes] 

2012-10-02  Ben Brosgol  <brosgol@adacore.com>

	* gnat_rm.texi: Minor editing.

2012-10-02  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Analyze_Function_Return): Reject a return
	expression whose type is a local access to subprogram type.

2012-10-02  Robert Dewar  <dewar@adacore.com>

	* sem_eval.adb: Minor improvement to Compile_Time_Compare.

2012-10-02  Robert Dewar  <dewar@adacore.com>

	* checks.adb (Apply_Arithmetic_Overflow_Minimized_Eliminated):
	Fix base type problem that resulted in improper conversion.
	(Minimize_Eliminate_Overflow_Checks): Properly handle top
	level case to avoid unnecessary conversion to bignum or LLI.
	(Minimize_Eliminate_Overflow_Checks): Implement uniform two phase
	approach for arithmetic operators and for if/case expressions.
	* checks.ads: Minor comment fix.
	* exp_ch4.adb (Minimized_Eliminated_Overflow_Check): New function,
	implements a uniform way of treating minimized/eliminated checks in
	two phases.
	(Expand_Compare_Minimize_Eliminate_Overflow): Fix cut and
	paste error resulting in wrong results for less than in some
	cases.	(Expand_Membership_Minimize_Eliminate_Overflow):
	Fix error caused by incorrect capture of operand types.
	(Expand_Membership_Minimize_Eliminate_Overflow): Fix error in
	handling of bignum case.
	(Expand_N_Case_Expression): Implement
	proper two phase handling (Expand_N_If_Expression): Implement
	proper two phase handling (Expand_N_Op_Abs): Implement proper
	two phase handling ditto for all other arithmetic operators
	* sem_res.adb (Resolve_If_Expression): Avoid introducing
	unneeded conversions.

From-SVN: r191980
This commit is contained in:
Arnaud Charlet 2012-10-02 15:05:08 +02:00
parent 6e6636ec8b
commit b6b5cca81b
8 changed files with 465 additions and 131 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
gcc/ada/ChangeLog
View File

@ -1,3 +1,41 @@
2012-10-02 Ben Brosgol <brosgol@adacore.com>
* gnat_rm.texi: Minor editing.
2012-10-02 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Analyze_Function_Return): Reject a return
expression whose type is a local access to subprogram type.
2012-10-02 Robert Dewar <dewar@adacore.com>
* sem_eval.adb: Minor improvement to Compile_Time_Compare.
2012-10-02 Robert Dewar <dewar@adacore.com>
* checks.adb (Apply_Arithmetic_Overflow_Minimized_Eliminated):
Fix base type problem that resulted in improper conversion.
(Minimize_Eliminate_Overflow_Checks): Properly handle top
level case to avoid unnecessary conversion to bignum or LLI.
(Minimize_Eliminate_Overflow_Checks): Implement uniform two phase
approach for arithmetic operators and for if/case expressions.
* checks.ads: Minor comment fix.
* exp_ch4.adb (Minimized_Eliminated_Overflow_Check): New function,
implements a uniform way of treating minimized/eliminated checks in
two phases.
(Expand_Compare_Minimize_Eliminate_Overflow): Fix cut and
paste error resulting in wrong results for less than in some
cases. (Expand_Membership_Minimize_Eliminate_Overflow):
Fix error caused by incorrect capture of operand types.
(Expand_Membership_Minimize_Eliminate_Overflow): Fix error in
handling of bignum case.
(Expand_N_Case_Expression): Implement
proper two phase handling (Expand_N_If_Expression): Implement
proper two phase handling (Expand_N_Op_Abs): Implement proper
two phase handling ditto for all other arithmetic operators
* sem_res.adb (Resolve_If_Expression): Avoid introducing
unneeded conversions.
2012-10-02 Robert Dewar <dewar@adacore.com> 2012-10-02 Robert Dewar <dewar@adacore.com>
* s-bignum.adb (Big_Exp): 0**0 should be 1, not 0. * s-bignum.adb (Big_Exp): 0**0 should be 1, not 0.

210
gcc/ada/checks.adb
View File

@ -854,7 +854,7 @@ package body Checks is
if Is_Signed_Integer_Type (Typ) if Is_Signed_Integer_Type (Typ)
and then Nkind (Parent (N)) = N_Type_Conversion and then Nkind (Parent (N)) = N_Type_Conversion
then then
declare Conversion_Optimization : declare
Target_Type : constant Entity_Id := Target_Type : constant Entity_Id :=
Base_Type (Entity (Subtype_Mark (Parent (N)))); Base_Type (Entity (Subtype_Mark (Parent (N))));
@ -918,7 +918,7 @@ package body Checks is
end if; end if;
end if; end if;
end if; end if;
end; end Conversion_Optimization;
end if; end if;
-- Now see if an overflow check is required -- Now see if an overflow check is required
@ -1129,9 +1129,11 @@ package body Checks is
-- top level, we have the proper type. This "undoing" is a point at -- top level, we have the proper type. This "undoing" is a point at
-- which a final overflow check may be applied. -- which a final overflow check may be applied.
-- If the result type was not fiddled we are all set -- If the result type was not fiddled we are all set. We go to base
-- types here because things may have been rewritten to generate the
-- base type of the operand types.
if Etype (Op) = Result_Type then if Base_Type (Etype (Op)) = Base_Type (Result_Type) then
return; return;
-- Bignum case -- Bignum case
@ -1204,10 +1206,13 @@ package body Checks is
Analyze_And_Resolve (Op); Analyze_And_Resolve (Op);
end; end;
-- Here we know the result is Long_Long_Integer'Base -- Here we know the result is Long_Long_Integer'Base, or that it
-- has been rewritten because the parent is a conversion (see
-- Apply_Arithmetic_Overflow_Check.Conversion_Optimization).
else else
pragma Assert (Etype (Op) = LLIB); pragma Assert
(Etype (Op) = LLIB or else Nkind (Parent (Op)) = N_Type_Conversion);
-- All we need to do here is to convert the result to the proper -- All we need to do here is to convert the result to the proper
-- result type. As explained above for the Bignum case, we can -- result type. As explained above for the Bignum case, we can
@ -6682,6 +6687,35 @@ package body Checks is
-- Minimize_Eliminate_Overflow_Checks -- -- Minimize_Eliminate_Overflow_Checks --
---------------------------------------- ----------------------------------------
-- This is a recursive routine that is called at the top of an expression
-- tree to properly process overflow checking for a whole subtree by making
-- recursive calls to process operands. This processing may involve the use
-- of bignum or long long integer arithmetic, which will change the types
-- of operands and results. That's why we can't do this bottom up (since
-- it would intefere with semantic analysis).
-- What happens is that if Minimized/Eliminated mode is in effect then
-- the operator expansion routines, as well as the expansion routines
-- for if/case expression test the Do_Overflow_Check flag and if it is
-- set they (for the moment) do nothing except call the routine to apply
-- the overflow check (Apply_Arithmetic_Overflow_Check). That routine
-- does nothing for non top-level nodes, so at the point where the call
-- is made for the top level node, the entire expression subtree has not
-- been expanded, or processed for overflow. All that has to happen as a
-- result of the top level call to this routine.
-- As noted above, the overflow processing works by making recursive calls
-- for the operands, and figuring out what to do, based on the processing
-- of these operands (e.g. if a bignum operand appears, the parent op has
-- to be done in bignum mode), and the determined ranges of the operands.
-- After possible rewriting of a constituent subexpression node, a call is
-- made to reanalyze the node after setting Analyzed to False. To avoid a
-- recursive call into the whole overflow apparatus, and important rule for
-- this reanalysis call is that either Do_Overflow_Check must be False, or
-- if it is set, then the overflow checking mode must be temporarily set
-- to Checked/Suppressed. Either step will avoid the unwanted recursion.
procedure Minimize_Eliminate_Overflow_Checks procedure Minimize_Eliminate_Overflow_Checks
(N : Node_Id; (N : Node_Id;
Lo : out Uint; Lo : out Uint;
@ -6743,10 +6777,14 @@ package body Checks is
function In_Result_Range return Boolean is function In_Result_Range return Boolean is
begin begin
if Is_Static_Subtype (Etype (N)) then if Lo = No_Uint or else Hi = No_Uint then
return False;
elsif Is_Static_Subtype (Etype (N)) then
return Lo >= Expr_Value (Type_Low_Bound (Rtyp)) return Lo >= Expr_Value (Type_Low_Bound (Rtyp))
and then and then
Hi <= Expr_Value (Type_High_Bound (Rtyp)); Hi <= Expr_Value (Type_High_Bound (Rtyp));
else else
return Lo >= Expr_Value (Type_Low_Bound (Base_Type (Rtyp))) return Lo >= Expr_Value (Type_Low_Bound (Base_Type (Rtyp)))
and then and then
@ -6853,10 +6891,13 @@ package body Checks is
-- If we have no Long_Long_Integer operands, then we are in result -- If we have no Long_Long_Integer operands, then we are in result
-- range, since it means that none of our operands felt the need -- range, since it means that none of our operands felt the need
-- to worry about overflow (otherwise it would have already been -- to worry about overflow (otherwise it would have already been
-- converted to long long integer or bignum). -- converted to long long integer or bignum). We reanalyze to
-- complete the expansion of the if expression
elsif not Long_Long_Integer_Operands then elsif not Long_Long_Integer_Operands then
Set_Do_Overflow_Check (N, False); Set_Do_Overflow_Check (N, False);
Set_Analyzed (N, False);
Analyze_And_Resolve (N, Suppress => Overflow_Check);
-- Otherwise convert us to long long integer mode. Note that we -- Otherwise convert us to long long integer mode. Note that we
-- don't need any further overflow checking at this level. -- don't need any further overflow checking at this level.
@ -6865,7 +6906,12 @@ package body Checks is
Convert_To_And_Rewrite (LLIB, Then_DE); Convert_To_And_Rewrite (LLIB, Then_DE);
Convert_To_And_Rewrite (LLIB, Else_DE); Convert_To_And_Rewrite (LLIB, Else_DE);
Set_Etype (N, LLIB); Set_Etype (N, LLIB);
-- Now reanalyze with overflow checks off
Set_Do_Overflow_Check (N, False); Set_Do_Overflow_Check (N, False);
Set_Analyzed (N, False);
Analyze_And_Resolve (N, LLIB, Suppress => Overflow_Check);
end if; end if;
end; end;
@ -6880,10 +6926,7 @@ package body Checks is
Hi := No_Uint; Hi := No_Uint;
declare declare
Alt : Node_Id; Alt : Node_Id;
New_Alts : List_Id;
New_Exp : Node_Id;
Rtype : Entity_Id;
begin begin
-- Loop through expressions applying recursive call -- Loop through expressions applying recursive call
@ -6915,40 +6958,48 @@ package body Checks is
-- we will properly reexpand and get the needed expansion for -- we will properly reexpand and get the needed expansion for
-- the case expression. -- the case expression.
if not (Bignum_Operands or else Long_Long_Integer_Operands) then if not (Bignum_Operands or Long_Long_Integer_Operands) then
Set_Do_Overflow_Check (N, False); Set_Do_Overflow_Check (N, False);
Set_Analyzed (N, False); Set_Analyzed (N, False);
Analyze_And_Resolve (N, Suppress => Overflow_Check);
-- Otherwise we are going to rebuild the case expression using -- Otherwise we are going to rebuild the case expression using
-- either bignum or long long integer operands throughout. -- either bignum or long long integer operands throughout.
else else
New_Alts := New_List; declare
Alt := First (Alternatives (N)); Rtype : Entity_Id;
while Present (Alt) loop New_Alts : List_Id;
if Bignum_Operands then New_Exp : Node_Id;
New_Exp := Convert_To_Bignum (Expression (Alt));
Rtype := RTE (RE_Bignum);
else
New_Exp := Convert_To (LLIB, Expression (Alt));
Rtype := LLIB;
end if;
Append_To (New_Alts, begin
Make_Case_Expression_Alternative (Sloc (Alt), New_Alts := New_List;
Actions => No_List, Alt := First (Alternatives (N));
Discrete_Choices => Discrete_Choices (Alt), while Present (Alt) loop
Expression => New_Exp)); if Bignum_Operands then
New_Exp := Convert_To_Bignum (Expression (Alt));
Rtype := RTE (RE_Bignum);
else
New_Exp := Convert_To (LLIB, Expression (Alt));
Rtype := LLIB;
end if;
Next (Alt); Append_To (New_Alts,
end loop; Make_Case_Expression_Alternative (Sloc (Alt),
Actions => No_List,
Discrete_Choices => Discrete_Choices (Alt),
Expression => New_Exp));
Rewrite (N, Next (Alt);
Make_Case_Expression (Loc, end loop;
Expression => Expression (N),
Alternatives => New_Alts));
Analyze_And_Resolve (N, Rtype, Suppress => Overflow_Check); Rewrite (N,
Make_Case_Expression (Loc,
Expression => Expression (N),
Alternatives => New_Alts));
Analyze_And_Resolve (N, Rtype, Suppress => Overflow_Check);
end;
end if; end if;
end; end;
@ -6967,7 +7018,17 @@ package body Checks is
(Left_Opnd (N), Llo, Lhi, Top_Level => False); (Left_Opnd (N), Llo, Lhi, Top_Level => False);
end if; end if;
-- If either operand is a bignum, then result will be a bignum -- Record if we have Long_Long_Integer operands
Long_Long_Integer_Operands :=
Etype (Right_Opnd (N)) = LLIB
or else (Binary and then Etype (Left_Opnd (N)) = LLIB);
-- If either operand is a bignum, then result will be a bignum and we
-- don't need to do any range analysis. As previously discussed we could
-- do range analysis in such cases, but it could mean working with giant
-- numbers at compile time for very little gain (the number of cases
-- in which we could slip back from bignum mode are small).
if Rlo = No_Uint or else (Binary and then Llo = No_Uint) then if Rlo = No_Uint or else (Binary and then Llo = No_Uint) then
Lo := No_Uint; Lo := No_Uint;
@ -7321,7 +7382,59 @@ package body Checks is
end case; end case;
end if; end if;
-- Case where we do the operation in Bignum mode. This happens either -- If we know we are in the result range, and we do not have Bignum
-- operands or Long_Long_Integer operands, we can just renalyze with
-- overflow checks turned off (since we know we cannot have overflow).
-- As always the reanalysis is required to complete expansion of the
-- operator, and we prevent recursion by suppressing the check.
if not (Bignum_Operands or Long_Long_Integer_Operands)
and then In_Result_Range
then
Set_Do_Overflow_Check (N, False);
Set_Analyzed (N, False);
Analyze_And_Resolve (N, Suppress => Overflow_Check);
return;
-- Here we know that we are not in the result range, and in the general
-- we will move into either the Bignum or Long_Long_Integer domain to
-- compute the result. However, there is one exception. If we are at the
-- top level, and we do not have Bignum or Long_Long_Integer operands,
-- we will have to immediately convert the result back to the result
-- type, so there is no point in Bignum/Long_Long_Integer fiddling.
elsif Top_Level
and then not (Bignum_Operands or Long_Long_Integer_Operands)
then
-- Here we will keep the original types, but we do need an overflow
-- check, so we will set Do_Overflow_Check to True (actually it is
-- true already, or how would we have got here?).
pragma Assert (Do_Overflow_Check (N));
Set_Analyzed (N, False);
-- One subtlety. We can't just go ahead and do an analyze operation
-- here because it will cause recursion into the whole minimized/
-- eliminated overflow processing which is not what we want. Here
-- we are at the top level, and we need a check against the result
-- mode (i.e. we want to use Checked mode). So do exactly that!
declare
Svg : constant Overflow_Check_Type :=
Scope_Suppress.Overflow_Checks_General;
Sva : constant Overflow_Check_Type :=
Scope_Suppress.Overflow_Checks_Assertions;
begin
Scope_Suppress.Overflow_Checks_General := Checked;
Scope_Suppress.Overflow_Checks_Assertions := Checked;
Analyze_And_Resolve (N);
Scope_Suppress.Overflow_Checks_General := Svg;
Scope_Suppress.Overflow_Checks_Assertions := Sva;
end;
return;
-- Cases where we do the operation in Bignum mode. This happens either
-- because one of our operands is in Bignum mode already, or because -- because one of our operands is in Bignum mode already, or because
-- the computed bounds are outside the bounds of Long_Long_Integer, -- the computed bounds are outside the bounds of Long_Long_Integer,
-- which in some cases can be indicated by Hi and Lo being No_Uint. -- which in some cases can be indicated by Hi and Lo being No_Uint.
@ -7331,10 +7444,10 @@ package body Checks is
-- 0 .. 1, but the cases are rare and it is not worth the effort. -- 0 .. 1, but the cases are rare and it is not worth the effort.
-- Failing to do this switching back is only an efficiency issue. -- Failing to do this switching back is only an efficiency issue.
if Lo = No_Uint or else Lo < LLLo or else Hi > LLHi then elsif Lo = No_Uint or else Lo < LLLo or else Hi > LLHi then
-- OK, we are definitely outside the range of Long_Long_Integer. The -- OK, we are definitely outside the range of Long_Long_Integer. The
-- question is whether to move into Bignum mode, or remain the domain -- question is whether to move to Bignum mode, or stay in the domain
-- of Long_Long_Integer, signalling that an overflow check is needed. -- of Long_Long_Integer, signalling that an overflow check is needed.
-- Obviously in MINIMIZED mode we stay with LLI, since we are not in -- Obviously in MINIMIZED mode we stay with LLI, since we are not in
@ -7440,12 +7553,21 @@ package body Checks is
Set_Do_Overflow_Check (N, False); Set_Do_Overflow_Check (N, False);
end if; end if;
-- If Result is in range of the result type, and we don't have any -- Here we are not in Bignum territory, but we may have long long
-- Long_Long_Integer operands, then overflow checking is not needed -- integer operands that need special handling. First a special check:
-- and we have nothing to do (we have already reset Do_Overflow_Check). -- If an exponentiation operator exponent is of type Long_Long_Integer,
-- it means we converted it to prevent overflow, but exponentiation
-- requires a Natural right operand, so convert it back to Natural.
-- This conversion may raise an exception which is fine.
if In_Result_Range and not Long_Long_Integer_Operands then if Nkind (N) = N_Op_Expon and then Etype (Right_Opnd (N)) = LLIB then
return; Convert_To_And_Rewrite (Standard_Natural, Right_Opnd (N));
-- Now Long_Long_Integer_Operands may have to be reset if that was
-- the only long long integer operand, i.e. we now have long long
-- integer operands only if the left operand is long long integer.
Long_Long_Integer_Operands := Etype (Left_Opnd (N)) = LLIB;
end if; end if;
-- Here we will do the operation in Long_Long_Integer. We do this even -- Here we will do the operation in Long_Long_Integer. We do this even

2
gcc/ada/checks.ads
View File

@ -142,7 +142,7 @@ package Checks is
-- overflow checking for dependent expressions. This routine handles -- overflow checking for dependent expressions. This routine handles
-- front end vs back end overflow checks (in the front end case it expands -- front end vs back end overflow checks (in the front end case it expands
-- the necessary check). Note that divide is handled separately using -- the necessary check). Note that divide is handled separately using
-- Apply_Arithmetic_Divide_Overflow_Check. -- Apply_Divide_Checks.
procedure Apply_Constraint_Check procedure Apply_Constraint_Check
(N : Node_Id; (N : Node_Id;

302
gcc/ada/exp_ch4.adb
View File

@ -212,6 +212,21 @@ package body Exp_Ch4 is
-- constrained type (the caller has ensured this by using -- constrained type (the caller has ensured this by using
-- Convert_To_Actual_Subtype if necessary). -- Convert_To_Actual_Subtype if necessary).
function Minimized_Eliminated_Overflow_Check (N : Node_Id) return Boolean;
-- For signed arithmetic operations with Do_Overflow_Check set when the
-- current overflow mode is MINIMIZED or ELIMINATED, we need to make a
-- call to Apply_Arithmetic_Overflow_Checks as the first thing we do. We
-- then return. We count on the recursive apparatus for overflow checks
-- to call us back with an equivalent operation that does not have the
-- Do_Overflow_Check flag set, and that is when we will proceed with the
-- expansion of the operator (e.g. converting X+0 to X, or X**2 to X*X).
-- We cannot do these optimizations without first making this check, since
-- there may be operands further down the tree that are relying on the
-- recursive calls triggered by the top level nodes to properly process
-- overflow checking and remaining expansion on these nodes. Note that
-- this call back may be skipped if the operation is done in Bignum mode
-- but that's fine, since the Bignum call takes care of everything.
procedure Optimize_Length_Comparison (N : Node_Id); procedure Optimize_Length_Comparison (N : Node_Id);
-- Given an expression, if it is of the form X'Length op N (or the other -- Given an expression, if it is of the form X'Length op N (or the other
-- way round), where N is known at compile time to be 0 or 1, and X is a -- way round), where N is known at compile time to be 0 or 1, and X is a
@ -2383,9 +2398,9 @@ package body Exp_Ch4 is
when N_Op_Lt => when N_Op_Lt =>
if Llo >= Rhi then if Llo >= Rhi then
Set_True;
elsif Lhi < Rlo then
Set_False; Set_False;
elsif Lhi < Rlo then
Set_True;
end if; end if;
when N_Op_Ne => when N_Op_Ne =>
@ -3721,11 +3736,14 @@ package body Exp_Ch4 is
-- Despite the name, this routine applies only to N_In, not to -- Despite the name, this routine applies only to N_In, not to
-- N_Not_In. The latter is always rewritten as not (X in Y). -- N_Not_In. The latter is always rewritten as not (X in Y).
Loc : constant Source_Ptr := Sloc (N); Loc : constant Source_Ptr := Sloc (N);
Lop : constant Node_Id := Left_Opnd (N); Lop : constant Node_Id := Left_Opnd (N);
Rop : constant Node_Id := Right_Opnd (N); Rop : constant Node_Id := Right_Opnd (N);
Ltype : constant Entity_Id := Etype (Lop);
Rtype : constant Entity_Id := Etype (Rop); -- Note: there are many referencs to Etype (Lop) and Etype (Rop). It
-- is thus tempting to capture these values, but due to the rewrites
-- that occur as a result of overflow checking, these values change
-- as we go along, and it is safe just to always use Etype explicitly.
Restype : constant Entity_Id := Etype (N); Restype : constant Entity_Id := Etype (N);
-- Save result type -- Save result type
@ -3743,19 +3761,24 @@ package body Exp_Ch4 is
-- predicate, then we can just replace the right operand with an -- predicate, then we can just replace the right operand with an
-- explicit range T'First .. T'Last, and use the explicit range code. -- explicit range T'First .. T'Last, and use the explicit range code.
if Nkind (Rop) /= N_Range and then No (Predicate_Function (Rtype)) then if Nkind (Rop) /= N_Range
Rewrite (Rop, and then No (Predicate_Function (Etype (Rop)))
Make_Range (Loc, then
Low_Bound => declare
Make_Attribute_Reference (Loc, Rtyp : constant Entity_Id := Etype (Rop);
Attribute_Name => Name_First, begin
Prefix => New_Reference_To (Rtype, Loc)), Rewrite (Rop,
Make_Range (Loc,
High_Bound => Low_Bound =>
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Attribute_Name => Name_Last, Attribute_Name => Name_First,
Prefix => New_Reference_To (Rtype, Loc)))); Prefix => New_Reference_To (Rtyp, Loc)),
Analyze_And_Resolve (Rop, Rtype, Suppress => All_Checks); High_Bound =>
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Last,
Prefix => New_Reference_To (Rtyp, Loc))));
Analyze_And_Resolve (Rop, Rtyp, Suppress => All_Checks);
end;
end if; end if;
-- Here for the explicit range case. Note that the bounds of the range -- Here for the explicit range case. Note that the bounds of the range
@ -3763,7 +3786,7 @@ package body Exp_Ch4 is
if Nkind (Rop) = N_Range then if Nkind (Rop) = N_Range then
Minimize_Eliminate_Overflow_Checks Minimize_Eliminate_Overflow_Checks
(Low_Bound (Rop), Lo, Hi, Top_Level => False); (Low_Bound (Rop), Lo, Hi, Top_Level => False);
Minimize_Eliminate_Overflow_Checks Minimize_Eliminate_Overflow_Checks
(High_Bound (Rop), Lo, Hi, Top_Level => False); (High_Bound (Rop), Lo, Hi, Top_Level => False);
@ -3771,7 +3794,7 @@ package body Exp_Ch4 is
-- Bignum case -- Bignum case
if Is_RTE (Ltype, RE_Bignum) if Is_RTE (Etype (Lop), RE_Bignum)
or else Is_RTE (Etype (Low_Bound (Rop)), RE_Bignum) or else Is_RTE (Etype (Low_Bound (Rop)), RE_Bignum)
or else Is_RTE (Etype (High_Bound (Rop)), RE_Bignum) or else Is_RTE (Etype (High_Bound (Rop)), RE_Bignum)
then then
@ -3841,9 +3864,9 @@ package body Exp_Ch4 is
else else
-- Case where types are all the same -- Case where types are all the same
if Ltype = Etype (Low_Bound (Rop)) if Base_Type (Etype (Lop)) = Base_Type (Etype (Low_Bound (Rop)))
and then and then
Ltype = Etype (High_Bound (Rop)) Base_Type (Etype (Lop)) = Base_Type (Etype (High_Bound (Rop)))
then then
null; null;
@ -3862,7 +3885,8 @@ package body Exp_Ch4 is
end if; end if;
-- Now the three operands are of the same signed integer type, -- Now the three operands are of the same signed integer type,
-- so we can use the normal expansion routine for membership. -- so we can use the normal expansion routine for membership,
-- setting the flag to prevent recursion into this procedure.
Set_No_Minimize_Eliminate (N); Set_No_Minimize_Eliminate (N);
Expand_N_In (N); Expand_N_In (N);
@ -3873,17 +3897,17 @@ package body Exp_Ch4 is
-- the standard N_In circuitry with appropriate types. -- the standard N_In circuitry with appropriate types.
else else
pragma Assert (Present (Predicate_Function (Rtype))); pragma Assert (Present (Predicate_Function (Etype (Rop))));
-- If types are "right", just call Expand_N_In preventing recursion -- If types are "right", just call Expand_N_In preventing recursion
if Base_Type (Ltype) = Base_Type (Rtype) then if Base_Type (Etype (Lop)) = Base_Type (Etype (Rop)) then
Set_No_Minimize_Eliminate (N); Set_No_Minimize_Eliminate (N);
Expand_N_In (N); Expand_N_In (N);
-- Bignum case -- Bignum case
elsif Is_RTE (Ltype, RE_Bignum) then elsif Is_RTE (Etype (Lop), RE_Bignum) then
-- For X in T, we want to insert code that looks like -- For X in T, we want to insert code that looks like
@ -3911,11 +3935,11 @@ package body Exp_Ch4 is
-- A bit gruesome, but here goes. -- A bit gruesome, but here goes.
declare declare
Blk : constant Node_Id := Make_Bignum_Block (Loc); Blk : constant Node_Id := Make_Bignum_Block (Loc);
Bnn : constant Entity_Id := Make_Temporary (Loc, 'B', N); Bnn : constant Entity_Id := Make_Temporary (Loc, 'B', N);
Lnn : constant Entity_Id := Make_Temporary (Loc, 'L', N); Lnn : constant Entity_Id := Make_Temporary (Loc, 'L', N);
Nnn : constant Entity_Id := Make_Temporary (Loc, 'N', N); Nnn : constant Entity_Id := Make_Temporary (Loc, 'N', N);
Nin : Node_Id; Nin : Node_Id;
begin begin
-- The last membership test is marked to prevent recursion -- The last membership test is marked to prevent recursion
@ -3923,9 +3947,9 @@ package body Exp_Ch4 is
Nin := Nin :=
Make_In (Loc, Make_In (Loc,
Left_Opnd => Left_Opnd =>
Convert_To (Base_Type (Rtype), Convert_To (Base_Type (Etype (Rop)),
New_Occurrence_Of (Lnn, Loc)), New_Occurrence_Of (Lnn, Loc)),
Right_Opnd => New_Occurrence_Of (Rtype, Loc)); Right_Opnd => New_Occurrence_Of (Etype (Rop), Loc));
Set_No_Minimize_Eliminate (Nin); Set_No_Minimize_Eliminate (Nin);
-- Now decorate the block -- Now decorate the block
@ -3985,7 +4009,7 @@ package body Exp_Ch4 is
New_Occurrence_Of (Lnn, Loc), New_Occurrence_Of (Lnn, Loc),
Right_Opnd => Right_Opnd =>
New_Occurrence_Of New_Occurrence_Of
(Base_Type (Rtype), Loc)), (Base_Type (Etype (Rop)), Loc)),
Right_Opnd => Nin)))))); Right_Opnd => Nin))))));
Insert_Actions (N, New_List ( Insert_Actions (N, New_List (
@ -4001,10 +4025,10 @@ package body Exp_Ch4 is
end; end;
-- Not bignum case, but types don't match (this means we rewrote the -- Not bignum case, but types don't match (this means we rewrote the
-- left operand to be Long_Long_Integer. -- left operand to be Long_Long_Integer).
else else
pragma Assert (Base_Type (Ltype) = LLIB); pragma Assert (Base_Type (Etype (Lop)) = LLIB);
-- We rewrite the membership test as -- We rewrite the membership test as
@ -4019,8 +4043,9 @@ package body Exp_Ch4 is
Nin := Nin :=
Make_In (Loc, Make_In (Loc,
Left_Opnd => Left_Opnd =>
Convert_To (Base_Type (Rtype), Duplicate_Subexpr (Lop)), Convert_To (Base_Type (Etype (Rop)),
Right_Opnd => New_Occurrence_Of (Rtype, Loc)); Duplicate_Subexpr (Lop)),
Right_Opnd => New_Occurrence_Of (Etype (Rop), Loc));
Set_No_Minimize_Eliminate (Nin); Set_No_Minimize_Eliminate (Nin);
-- Now do the rewrite -- Now do the rewrite
@ -4031,7 +4056,7 @@ package body Exp_Ch4 is
Make_In (Loc, Make_In (Loc,
Left_Opnd => Lop, Left_Opnd => Lop,
Right_Opnd => Right_Opnd =>
New_Occurrence_Of (Base_Type (Ltype), Loc)), New_Occurrence_Of (Base_Type (Etype (Lop)), Loc)),
Right_Opnd => Nin)); Right_Opnd => Nin));
Analyze_And_Resolve (N, Restype, Suppress => All_Checks); Analyze_And_Resolve (N, Restype, Suppress => All_Checks);
@ -4776,14 +4801,9 @@ package body Exp_Ch4 is
Fexp : Node_Id; Fexp : Node_Id;
begin begin
-- If Do_Overflow_Check is set, it means we are in MINIMIZED/ELIMINATED -- Check for MINIMIZED/ELIMINATED overflow mode
-- mode, and all we do is to call Apply_Arithmetic_Overflow_Check to
-- ensure proper overflow handling for the dependent expressions. The
-- checks circuitry will rewrite the case expression in this case with
-- Do_Overflow_Checks off. so that when that rewritten node arrives back
-- here, then we will do the full expansion.
if Do_Overflow_Check (N) then if Minimized_Eliminated_Overflow_Check (N) then
Apply_Arithmetic_Overflow_Check (N); Apply_Arithmetic_Overflow_Check (N);
return; return;
end if; end if;
@ -5170,6 +5190,13 @@ package body Exp_Ch4 is
New_N : Node_Id; New_N : Node_Id;
begin begin
-- Check for MINIMIZED/ELIMINATED overflow mode
if Minimized_Eliminated_Overflow_Check (N) then
Apply_Arithmetic_Overflow_Check (N);
return;
end if;
-- Fold at compile time if condition known. We have already folded -- Fold at compile time if condition known. We have already folded
-- static if expressions, but it is possible to fold any case in which -- static if expressions, but it is possible to fold any case in which
-- the condition is known at compile time, even though the result is -- the condition is known at compile time, even though the result is
@ -5383,15 +5410,6 @@ package body Exp_Ch4 is
-- the same approach as a C conditional expression. -- the same approach as a C conditional expression.
else else
-- If Do_Overflow_Check is set it means we have a signed intger type
-- in MINIMIZED or ELIMINATED mode, so we apply an overflow check to
-- the if expression (to make sure that overflow checking is properly
-- handled for dependent expressions).
if Do_Overflow_Check (N) then
Apply_Arithmetic_Overflow_Check (N);
end if;
return; return;
end if; end if;
@ -5500,18 +5518,35 @@ package body Exp_Ch4 is
-- Check case of explicit test for an expression in range of its -- Check case of explicit test for an expression in range of its
-- subtype. This is suspicious usage and we replace it with a 'Valid -- subtype. This is suspicious usage and we replace it with a 'Valid
-- test and give a warning. For floating point types however, this is a -- test and give a warning for scalar types.
-- standard way to check for finite numbers, and using 'Valid would
-- typically be a pessimization. Also skip this test for predicated
-- types, since it is perfectly reasonable to check if a value meets
-- its predicate.
if Is_Scalar_Type (Ltyp) if Is_Scalar_Type (Ltyp)
-- Only relevant for source comparisons
and then Comes_From_Source (N)
-- In floating-point this is a standard way to check for finite values
-- and using 'Valid would typically be a pessimization.
and then not Is_Floating_Point_Type (Ltyp) and then not Is_Floating_Point_Type (Ltyp)
-- Don't give the message unless right operand is a type entity and
-- the type of the left operand matches this type. Note that this
-- eliminates the cases where MINIMIZED/ELIMINATED mode overflow
-- checks have changed the type of the left operand.
and then Nkind (Rop) in N_Has_Entity and then Nkind (Rop) in N_Has_Entity
and then Ltyp = Entity (Rop) and then Ltyp = Entity (Rop)
and then Comes_From_Source (N)
-- Skip in VM mode, where we have no sense of invalid values. The
-- warning still seems relevant, but not important enough to worry.
and then VM_Target = No_VM and then VM_Target = No_VM
-- Skip this for predicated types, where such expressions are a
-- reasonable way of testing if something meets the predicate.
and then not (Is_Discrete_Type (Ltyp) and then not (Is_Discrete_Type (Ltyp)
and then Present (Predicate_Function (Ltyp))) and then Present (Predicate_Function (Ltyp)))
then then
@ -5564,15 +5599,30 @@ package body Exp_Ch4 is
-- Could use some individual comments for this complex test ??? -- Could use some individual comments for this complex test ???
if Is_Scalar_Type (Ltyp) if Is_Scalar_Type (Ltyp)
-- And left operand is X'First where X matches left operand
-- type (this eliminates cases of type mismatch, including
-- the cases where ELIMINATED/MINIMIZED mode has changed the
-- type of the left operand.
and then Nkind (Lo_Orig) = N_Attribute_Reference and then Nkind (Lo_Orig) = N_Attribute_Reference
and then Attribute_Name (Lo_Orig) = Name_First and then Attribute_Name (Lo_Orig) = Name_First
and then Nkind (Prefix (Lo_Orig)) in N_Has_Entity and then Nkind (Prefix (Lo_Orig)) in N_Has_Entity
and then Entity (Prefix (Lo_Orig)) = Ltyp and then Entity (Prefix (Lo_Orig)) = Ltyp
-- Same tests for right operand
and then Nkind (Hi_Orig) = N_Attribute_Reference and then Nkind (Hi_Orig) = N_Attribute_Reference
and then Attribute_Name (Hi_Orig) = Name_Last and then Attribute_Name (Hi_Orig) = Name_Last
and then Nkind (Prefix (Hi_Orig)) in N_Has_Entity and then Nkind (Prefix (Hi_Orig)) in N_Has_Entity
and then Entity (Prefix (Hi_Orig)) = Ltyp and then Entity (Prefix (Hi_Orig)) = Ltyp
-- Relevant only for source cases
and then Comes_From_Source (N) and then Comes_From_Source (N)
-- Omit for VM cases, where we don't have invalid values
and then VM_Target = No_VM and then VM_Target = No_VM
then then
Substitute_Valid_Check; Substitute_Valid_Check;
@ -6331,6 +6381,13 @@ package body Exp_Ch4 is
begin begin
Unary_Op_Validity_Checks (N); Unary_Op_Validity_Checks (N);
-- Check for MINIMIZED/ELIMINATED overflow mode
if Minimized_Eliminated_Overflow_Check (N) then
Apply_Arithmetic_Overflow_Check (N);
return;
end if;
-- Deal with software overflow checking -- Deal with software overflow checking
if not Backend_Overflow_Checks_On_Target if not Backend_Overflow_Checks_On_Target
@ -6374,6 +6431,13 @@ package body Exp_Ch4 is
begin begin
Binary_Op_Validity_Checks (N); Binary_Op_Validity_Checks (N);
-- Check for MINIMIZED/ELIMINATED overflow mode
if Minimized_Eliminated_Overflow_Check (N) then
Apply_Arithmetic_Overflow_Check (N);
return;
end if;
-- N + 0 = 0 + N = N for integer types -- N + 0 = 0 + N = N for integer types
if Is_Integer_Type (Typ) then if Is_Integer_Type (Typ) then
@ -6516,6 +6580,15 @@ package body Exp_Ch4 is
begin begin
Binary_Op_Validity_Checks (N); Binary_Op_Validity_Checks (N);
-- Check for MINIMIZED/ELIMINATED overflow mode
if Minimized_Eliminated_Overflow_Check (N) then
Apply_Arithmetic_Overflow_Check (N);
return;
end if;
-- Otherwise proceed with expansion of division
if Rknow then if Rknow then
Rval := Expr_Value (Ropnd); Rval := Expr_Value (Ropnd);
end if; end if;
@ -7284,19 +7357,9 @@ package body Exp_Ch4 is
end; end;
end if; end if;
-- Normally we complete expansion of exponentiation (e.g. converting -- Check for MINIMIZED/ELIMINATED overflow mode
-- to multplications) right here, but there is one exception to this.
-- If we have a signed integer type and the overflow checking mode
-- is MINIMIZED or ELIMINATED and overflow checking is activated, then
-- we don't yet want to expand, since that will intefere with handling
-- of extended precision intermediate value. In this situation we just
-- apply the arithmetic overflow check, and then the overflow check
-- circuit will re-expand the exponentiation node in CHECKED mode.
if Is_Signed_Integer_Type (Rtyp) if Minimized_Eliminated_Overflow_Check (N) then
and then Overflow_Check_Mode (Typ) in Minimized_Or_Eliminated
and then Do_Overflow_Check (N)
then
Apply_Arithmetic_Overflow_Check (N); Apply_Arithmetic_Overflow_Check (N);
return; return;
end if; end if;
@ -7792,6 +7855,13 @@ package body Exp_Ch4 is
begin begin
Unary_Op_Validity_Checks (N); Unary_Op_Validity_Checks (N);
-- Check for MINIMIZED/ELIMINATED overflow mode
if Minimized_Eliminated_Overflow_Check (N) then
Apply_Arithmetic_Overflow_Check (N);
return;
end if;
if not Backend_Overflow_Checks_On_Target if not Backend_Overflow_Checks_On_Target
and then Is_Signed_Integer_Type (Etype (N)) and then Is_Signed_Integer_Type (Etype (N))
and then Do_Overflow_Check (N) and then Do_Overflow_Check (N)
@ -7819,11 +7889,12 @@ package body Exp_Ch4 is
procedure Expand_N_Op_Mod (N : Node_Id) is procedure Expand_N_Op_Mod (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N); Loc : constant Source_Ptr := Sloc (N);
Typ : constant Entity_Id := Etype (N); Typ : constant Entity_Id := Etype (N);
Left : constant Node_Id := Left_Opnd (N);
Right : constant Node_Id := Right_Opnd (N);
DOC : constant Boolean := Do_Overflow_Check (N); DOC : constant Boolean := Do_Overflow_Check (N);
DDC : constant Boolean := Do_Division_Check (N); DDC : constant Boolean := Do_Division_Check (N);
Left : Node_Id;
Right : Node_Id;
LLB : Uint; LLB : Uint;
Llo : Uint; Llo : Uint;
Lhi : Uint; Lhi : Uint;
@ -7837,10 +7908,29 @@ package body Exp_Ch4 is
begin begin
Binary_Op_Validity_Checks (N); Binary_Op_Validity_Checks (N);
-- Check for MINIMIZED/ELIMINATED overflow mode
if Minimized_Eliminated_Overflow_Check (N) then
Apply_Arithmetic_Overflow_Check (N);
return;
end if;
if Is_Integer_Type (Etype (N)) then if Is_Integer_Type (Etype (N)) then
Apply_Divide_Checks (N); Apply_Divide_Checks (N);
-- All done if we don't have a MOD any more, which can happen as a
-- result of overflow expansion in MINIMIZED or ELIMINATED modes.
if Nkind (N) /= N_Op_Mod then
return;
end if;
end if; end if;
-- Proceed with expansion of mod operator
Left := Left_Opnd (N);
Right := Right_Opnd (N);
Determine_Range (Right, ROK, Rlo, Rhi, Assume_Valid => True); Determine_Range (Right, ROK, Rlo, Rhi, Assume_Valid => True);
Determine_Range (Left, LOK, Llo, Lhi, Assume_Valid => True); Determine_Range (Left, LOK, Llo, Lhi, Assume_Valid => True);
@ -7960,6 +8050,13 @@ package body Exp_Ch4 is
begin begin
Binary_Op_Validity_Checks (N); Binary_Op_Validity_Checks (N);
-- Check for MINIMIZED/ELIMINATED overflow mode
if Minimized_Eliminated_Overflow_Check (N) then
Apply_Arithmetic_Overflow_Check (N);
return;
end if;
-- Special optimizations for integer types -- Special optimizations for integer types
if Is_Integer_Type (Typ) then if Is_Integer_Type (Typ) then
@ -8482,6 +8579,13 @@ package body Exp_Ch4 is
procedure Expand_N_Op_Plus (N : Node_Id) is procedure Expand_N_Op_Plus (N : Node_Id) is
begin begin
Unary_Op_Validity_Checks (N); Unary_Op_Validity_Checks (N);
-- Check for MINIMIZED/ELIMINATED overflow mode
if Minimized_Eliminated_Overflow_Check (N) then
Apply_Arithmetic_Overflow_Check (N);
return;
end if;
end Expand_N_Op_Plus; end Expand_N_Op_Plus;
--------------------- ---------------------
@ -8492,8 +8596,8 @@ package body Exp_Ch4 is
Loc : constant Source_Ptr := Sloc (N); Loc : constant Source_Ptr := Sloc (N);
Typ : constant Entity_Id := Etype (N); Typ : constant Entity_Id := Etype (N);
Left : constant Node_Id := Left_Opnd (N); Left : Node_Id;
Right : constant Node_Id := Right_Opnd (N); Right : Node_Id;
Lo : Uint; Lo : Uint;
Hi : Uint; Hi : Uint;
@ -8508,10 +8612,29 @@ package body Exp_Ch4 is
begin begin
Binary_Op_Validity_Checks (N); Binary_Op_Validity_Checks (N);
-- Check for MINIMIZED/ELIMINATED overflow mode
if Minimized_Eliminated_Overflow_Check (N) then
Apply_Arithmetic_Overflow_Check (N);
return;
end if;
if Is_Integer_Type (Etype (N)) then if Is_Integer_Type (Etype (N)) then
Apply_Divide_Checks (N); Apply_Divide_Checks (N);
-- All done if we don't have a REM any more, which can happen as a
-- result of overflow expansion in MINIMIZED or ELIMINATED modes.
if Nkind (N) /= N_Op_Rem then
return;
end if;
end if; end if;
-- Proceed with expansion of REM
Left := Left_Opnd (N);
Right := Right_Opnd (N);
-- Apply optimization x rem 1 = 0. We don't really need that with gcc, -- Apply optimization x rem 1 = 0. We don't really need that with gcc,
-- but it is useful with other back ends (e.g. AAMP), and is certainly -- but it is useful with other back ends (e.g. AAMP), and is certainly
-- harmless. -- harmless.
@ -8624,6 +8747,13 @@ package body Exp_Ch4 is
begin begin
Binary_Op_Validity_Checks (N); Binary_Op_Validity_Checks (N);
-- Check for MINIMIZED/ELIMINATED overflow mode
if Minimized_Eliminated_Overflow_Check (N) then
Apply_Arithmetic_Overflow_Check (N);
return;
end if;
-- N - 0 = N for integer types -- N - 0 = N for integer types
if Is_Integer_Type (Typ) if Is_Integer_Type (Typ)
@ -11626,6 +11756,18 @@ package body Exp_Ch4 is
return Func_Body; return Func_Body;
end Make_Boolean_Array_Op; end Make_Boolean_Array_Op;
-----------------------------------------
-- Minimized_Eliminated_Overflow_Check --
-----------------------------------------
function Minimized_Eliminated_Overflow_Check (N : Node_Id) return Boolean is
begin
return
Is_Signed_Integer_Type (Etype (N))
and then Do_Overflow_Check (N)
and then Overflow_Check_Mode (Empty) in Minimized_Or_Eliminated;
end Minimized_Eliminated_Overflow_Check;
-------------------------------- --------------------------------
-- Optimize_Length_Comparison -- -- Optimize_Length_Comparison --
-------------------------------- --------------------------------
@ -12216,7 +12358,7 @@ package body Exp_Ch4 is
end if; end if;
end Is_Safe_Operand; end Is_Safe_Operand;
-- Start of processing for Is_Safe_In_Place_Array_Op -- Start of processing for Safe_In_Place_Array_Op
begin begin
-- Skip this processing if the component size is different from system -- Skip this processing if the component size is different from system

6
gcc/ada/gnat_rm.texi
View File

@ -4147,7 +4147,8 @@ MODE ::= SUPPRESSED | CHECKED | MINIMIZED | ELIMINATED
@noindent @noindent
This pragma sets the current overflow mode to the given mode. For details This pragma sets the current overflow mode to the given mode. For details
of the meaning of these modes, see section on overflow checking in the of the meaning of these modes, please refer to the
``Overflow Check Handling in GNAT'' appendix in the
@value{EDITION} User's Guide. If only the @code{General} parameter is present, @value{EDITION} User's Guide. If only the @code{General} parameter is present,
the given mode applies to all expressions. If both parameters are present, the given mode applies to all expressions. If both parameters are present,
the @code{General} mode applies to expressions outside assertions, and the @code{General} mode applies to expressions outside assertions, and
@ -4169,6 +4170,7 @@ The pragma @code{Suppress (Overflow_Check)} sets mode
General => Suppressed General => Suppressed
@end smallexample @end smallexample
@noindent
suppressing all overflow checking within and outside suppressing all overflow checking within and outside
assertions. assertions.
@ -4178,9 +4180,11 @@ The pragam @code{Unsuppress (Overflow_Check)} sets mode
General => Checked General => Checked
@end smallexample @end smallexample
@noindent
which causes overflow checking of all intermediate overflows. which causes overflow checking of all intermediate overflows.
This applies both inside and outside assertions. This applies both inside and outside assertions.
@node Pragma Passive @node Pragma Passive
@unnumberedsec Pragma Passive @unnumberedsec Pragma Passive
@findex Passive @findex Passive

18
gcc/ada/sem_ch6.adb
View File

@ -869,6 +869,24 @@ package body Sem_Ch6 is
then then
Rewrite (Expr, Convert_To (R_Type, Relocate_Node (Expr))); Rewrite (Expr, Convert_To (R_Type, Relocate_Node (Expr)));
Analyze_And_Resolve (Expr, R_Type); Analyze_And_Resolve (Expr, R_Type);
-- If this is a local anonymous access to subprogram, the
-- accessibility check can be applied statically. The return is
-- illegal if the access type of the return expression is declared
-- inside of the subprogram (except if it is the subtype indication
-- of an extended return statement).
elsif Ekind (R_Type) = E_Anonymous_Access_Subprogram_Type then
if not Comes_From_Source (Current_Scope)
or else Ekind (Current_Scope) = E_Return_Statement
then
null;
elsif
Scope_Depth (Scope (Etype (Expr))) >= Scope_Depth (Scope_Id)
then
Error_Msg_N ("cannot return local access to subprogram", N);
end if;
end if; end if;
-- If the result type is class-wide, then check that the return -- If the result type is class-wide, then check that the return

18
gcc/ada/sem_eval.adb
View File

@ -949,21 +949,31 @@ package body Sem_Eval is
LLo, LHi : Uint; LLo, LHi : Uint;
RLo, RHi : Uint; RLo, RHi : Uint;
Single : Boolean;
-- True if each range is a single point
begin begin
Determine_Range (L, LOK, LLo, LHi, Assume_Valid); Determine_Range (L, LOK, LLo, LHi, Assume_Valid);
Determine_Range (R, ROK, RLo, RHi, Assume_Valid); Determine_Range (R, ROK, RLo, RHi, Assume_Valid);
if LOK and ROK then if LOK and ROK then
Single := (LLo = LHi) and then (RLo = RHi);
if LHi < RLo then if LHi < RLo then
if Single and Assume_Valid then
Diff.all := RLo - LLo;
end if;
return LT; return LT;
elsif RHi < LLo then elsif RHi < LLo then
if Single and Assume_Valid then
Diff.all := LLo - RLo;
end if;
return GT; return GT;
elsif LLo = LHi elsif Single and then LLo = RLo then
and then RLo = RHi
and then LLo = RLo
then
-- If the range includes a single literal and we can assume -- If the range includes a single literal and we can assume
-- validity then the result is known even if an operand is -- validity then the result is known even if an operand is

2
gcc/ada/sem_res.adb
View File

@ -7162,7 +7162,7 @@ package body Sem_Res is
-- a constraint check. -- a constraint check.
if Is_Scalar_Type (Then_Typ) if Is_Scalar_Type (Then_Typ)
and then Then_Typ /= Typ and then Base_Type (Then_Typ) /= Base_Type (Typ)
then then
Rewrite (Then_Expr, Convert_To (Typ, Then_Expr)); Rewrite (Then_Expr, Convert_To (Typ, Then_Expr));
Analyze_And_Resolve (Then_Expr, Typ); Analyze_And_Resolve (Then_Expr, Typ);