From 4d7d2736587ecfb99b513645dda7460f9100f69c Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 12 Aug 2019 08:58:57 +0000 Subject: [PATCH] [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 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 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/sem_res.adb | 26 +++++++++++++++++++------- 2 files changed, 27 insertions(+), 7 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7c7aa8330a0..315b4f64d63 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2019-08-12 Eric Botcazou + + * 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 * checks.adb (Insert_Valid_Check): Reset the Do_Range_Check flag diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 8162b8e0520..ecd8bc094ff 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -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). -- 2.30.2