[Ada] Add special bypass for obsolete code pattern

This change prevents the analysis phase of the front-end from setting
the Do_Range_Check flag in the very peculiar case of the source of a
conversion whose result is passed by reference to a "valued procedure",
because the expansion phase would not be able to generate the check.

This pattern appears in the ancient DEC Starlet package and it doesn't
seem to be useful at this point to change the expander to deal with it,
so instead the analysis phase is adjusted.  Morever the compiler already
issues a warning in this case so this is probably good enough.

2019-08-12  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* sem_res.adb: Add with & use clause for Sem_Mech and
	alphabetize.
	(Resolve_Actuals): Do not apply a scalar range check for the
	source of a conversion whose result is passed by reference to a
	valued procedure.

From-SVN: r274281
This commit is contained in:
Eric Botcazou 2019-08-12 08:58:57 +00:00 committed by Pierre-Marie de Rodat
parent 13931a38fc
commit 4d7d273658
2 changed files with 27 additions and 7 deletions

View File

@ -1,3 +1,11 @@
2019-08-12 Eric Botcazou <ebotcazou@adacore.com>
* sem_res.adb: Add with & use clause for Sem_Mech and
alphabetize.
(Resolve_Actuals): Do not apply a scalar range check for the
source of a conversion whose result is passed by reference to a
valued procedure.
2019-08-12 Eric Botcazou <ebotcazou@adacore.com>
* checks.adb (Insert_Valid_Check): Reset the Do_Range_Check flag

View File

@ -30,9 +30,9 @@ with Debug_A; use Debug_A;
with Einfo; use Einfo;
with Errout; use Errout;
with Expander; use Expander;
with Exp_Disp; use Exp_Disp;
with Exp_Ch6; use Exp_Ch6;
with Exp_Ch7; use Exp_Ch7;
with Exp_Disp; use Exp_Disp;
with Exp_Tss; use Exp_Tss;
with Exp_Util; use Exp_Util;
with Freeze; use Freeze;
@ -51,12 +51,12 @@ with Restrict; use Restrict;
with Rident; use Rident;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Aggr; use Sem_Aggr;
with Sem_Attr; use Sem_Attr;
with Sem_Aux; use Sem_Aux;
with Sem_Cat; use Sem_Cat;
with Sem_Ch4; use Sem_Ch4;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch4; use Sem_Ch4;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;
with Sem_Ch13; use Sem_Ch13;
@ -67,9 +67,9 @@ with Sem_Elab; use Sem_Elab;
with Sem_Elim; use Sem_Elim;
with Sem_Eval; use Sem_Eval;
with Sem_Intr; use Sem_Intr;
with Sem_Util; use Sem_Util;
with Targparm; use Targparm;
with Sem_Mech; use Sem_Mech;
with Sem_Type; use Sem_Type;
with Sem_Util; use Sem_Util;
with Sem_Warn; use Sem_Warn;
with Sinfo; use Sinfo;
with Sinfo.CN; use Sinfo.CN;
@ -77,6 +77,7 @@ with Snames; use Snames;
with Stand; use Stand;
with Stringt; use Stringt;
with Style; use Style;
with Targparm; use Targparm;
with Tbuild; use Tbuild;
with Uintp; use Uintp;
with Urealp; use Urealp;
@ -4613,8 +4614,19 @@ package body Sem_Res is
if Nkind (A) = N_Type_Conversion then
if Is_Scalar_Type (A_Typ) then
Apply_Scalar_Range_Check
(Expression (A), Etype (Expression (A)), A_Typ);
-- Special case here tailored to Exp_Ch6.Is_Legal_Copy,
-- which would prevent the check from being generated.
-- This is for Starlet only though, so long obsolete.
if Mechanism (F) = By_Reference
and then Is_Valued_Procedure (Nam)
then
null;
else
Apply_Scalar_Range_Check
(Expression (A), Etype (Expression (A)), A_Typ);
end if;
-- In addition the return value must meet the constraints
-- of the object type (see the comment below).