From e0666fc62f436b35e9ad3b806cb081d95f2f66c6 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 25 Apr 2017 15:58:36 +0200 Subject: [multiple changes] 2017-04-25 Gary Dismukes * exp_util.adb, exp_ch4.adb: Minor reformatting. 2017-04-25 Hristian Kirtchev * checks.adb: Code clean up in various routines. (Generate_Range_Check): Do not generate a range check when the expander is not active or when index/range checks are suppressed on the target type. (Insert_List_After_And_Analyze, Insert_List_Before_And_Analyze): Remove variants that include a Supress parameter. These routines are never used, and were introduced before the current scope-based check suppression method. 2017-04-25 Vasiliy Fofanov * prj-part.adb, cstreams.c, osint.adb, osint.ads: Remove VMS specific code and some subprogram calls that are now noop. From-SVN: r247242 --- gcc/ada/checks.adb | 56 +++++++++++++++++++++++++++++++++++------------------- 1 file changed, 36 insertions(+), 20 deletions(-) (limited to 'gcc/ada/checks.adb') diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 2bcd059..6f0dace 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -489,17 +489,18 @@ package body Checks is Static_Sloc : Source_Ptr; Flag_Node : Node_Id) is + Checks_On : constant Boolean := + not Index_Checks_Suppressed (Suppress_Typ) + or else + not Range_Checks_Suppressed (Suppress_Typ); + Internal_Flag_Node : constant Node_Id := Flag_Node; Internal_Static_Sloc : constant Source_Ptr := Static_Sloc; - Checks_On : constant Boolean := - (not Index_Checks_Suppressed (Suppress_Typ)) - or else (not Range_Checks_Suppressed (Suppress_Typ)); - begin - -- For now we just return if Checks_On is false, however this should - -- be enhanced to check for an always True value in the condition - -- and to generate a compilation warning??? + -- For now we just return if Checks_On is false, however this should be + -- enhanced to check for an always True value in the condition and to + -- generate a compilation warning??? if not Checks_On then return; @@ -3116,14 +3117,16 @@ package body Checks is Source_Typ : Entity_Id; Do_Static : Boolean) is + Checks_On : constant Boolean := + not Index_Checks_Suppressed (Target_Typ) + or else + not Length_Checks_Suppressed (Target_Typ); + + Loc : constant Source_Ptr := Sloc (Ck_Node); + Cond : Node_Id; - R_Result : Check_Result; R_Cno : Node_Id; - - Loc : constant Source_Ptr := Sloc (Ck_Node); - Checks_On : constant Boolean := - (not Index_Checks_Suppressed (Target_Typ)) - or else (not Length_Checks_Suppressed (Target_Typ)); + R_Result : Check_Result; begin -- Only apply checks when generating code @@ -3228,12 +3231,13 @@ package body Checks is Source_Typ : Entity_Id; Do_Static : Boolean) is - Loc : constant Source_Ptr := Sloc (Ck_Node); Checks_On : constant Boolean := not Index_Checks_Suppressed (Target_Typ) or else not Range_Checks_Suppressed (Target_Typ); + Loc : constant Source_Ptr := Sloc (Ck_Node); + Cond : Node_Id; R_Cno : Node_Id; R_Result : Check_Result; @@ -6693,9 +6697,20 @@ package body Checks is Set_Etype (N, Target_Base_Type); end Convert_And_Check_Range; + -- Local variables + + Checks_On : constant Boolean := + not Index_Checks_Suppressed (Target_Type) + or else + not Range_Checks_Suppressed (Target_Type); + -- Start of processing for Generate_Range_Check begin + if not Expander_Active or not Checks_On then + return; + end if; + -- 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 -- stopped Do_Range_Check from being set in the first place, but better @@ -7155,14 +7170,15 @@ package body Checks is Flag_Node : Node_Id := Empty; Do_Before : Boolean := False) is + Checks_On : constant Boolean := + not Index_Checks_Suppressed (Suppress_Typ) + or else + not Range_Checks_Suppressed (Suppress_Typ); + + Check_Node : Node_Id; Internal_Flag_Node : Node_Id := Flag_Node; Internal_Static_Sloc : Source_Ptr := Static_Sloc; - Check_Node : Node_Id; - Checks_On : constant Boolean := - (not Index_Checks_Suppressed (Suppress_Typ)) - or else (not Range_Checks_Suppressed (Suppress_Typ)); - begin -- For now we just return if Checks_On is false, however this should be -- enhanced to check for an always True value in the condition and to -- cgit v1.1