From 9fc0f6728d4eabdfe3ca2937b96f98b7c69f46a4 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 13 Mar 2015 14:22:52 +0100 Subject: [PATCH] [multiple changes] 2015-03-13 Gary Dismukes * style.adb (Missing_Overriding): Apply the Comes_From_Source test to the Original_Node of the subprogram node, to handle the case of a null procedure declaration that has been rewritten as an empty procedure body. 2015-03-13 Robert Dewar * exp_util.ads: Minor fix to comment. * sem_ch3.adb (Constrain_Index): Correct pasto from previous change. From-SVN: r221419 --- gcc/ada/ChangeLog | 13 +++++++++++++ gcc/ada/exp_util.ads | 2 +- gcc/ada/sem_ch3.adb | 20 ++++++++++---------- gcc/ada/style.adb | 9 ++++++--- 4 files changed, 30 insertions(+), 14 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d9b7325dc5e..3b961475cc4 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2015-03-13 Gary Dismukes + + * style.adb (Missing_Overriding): Apply the + Comes_From_Source test to the Original_Node of the subprogram + node, to handle the case of a null procedure declaration that + has been rewritten as an empty procedure body. + +2015-03-13 Robert Dewar + + * exp_util.ads: Minor fix to comment. + * sem_ch3.adb (Constrain_Index): Correct pasto from previous + change. + 2015-03-13 Robert Dewar * exp_util.ads, exp_util.adb (Force_Evaluation): Add Related_Id and diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 1e5aec1584d..9c2341af59c 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -881,7 +881,7 @@ package Exp_Util is -- Is_Low_Bound and Is_High_Bound specify whether the expression to check -- is the low or the high bound of a range. These three optional arguments -- signal Remove_Side_Effects to create an external symbol of the form - -- Chars (Related_Id)_FIRST/_LAST. If Related_Id is set, the exactly one + -- Chars (Related_Id)_FIRST/_LAST. If Related_Id is set, then exactly one -- of the Is_xxx_Bound flags must be set. For use of these parameters see -- the warning in the body of Sem_Ch3.Process_Range_Expr_In_Decl. diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 3ec9ab523aa..53fc26166a3 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -13172,6 +13172,10 @@ package body Sem_Ch3 is T : constant Entity_Id := Etype (Index); begin + Def_Id := + Create_Itype (E_Void, Related_Nod, Related_Id, Suffix, Suffix_Index); + Set_Etype (Def_Id, Base_Type (T)); + if Nkind (S) = N_Range or else (Nkind (S) = N_Attribute_Reference @@ -13221,9 +13225,9 @@ package body Sem_Ch3 is if Expander_Active or GNATprove_Mode then Force_Evaluation - (Low_Bound (R), Related_Id => Related_Id, Is_Low_Bound => True); + (Low_Bound (R), Related_Id => Def_Id, Is_Low_Bound => True); Force_Evaluation - (High_Bound (R), Related_Id => Related_Id, Is_Low_Bound => True); + (High_Bound (R), Related_Id => Def_Id, Is_High_Bound => True); end if; elsif Nkind (S) = N_Discriminant_Association then @@ -13263,10 +13267,7 @@ package body Sem_Ch3 is end if; end if; - Def_Id := - Create_Itype (E_Void, Related_Nod, Related_Id, Suffix, Suffix_Index); - - Set_Etype (Def_Id, Base_Type (T)); + -- Complete construction of the Itype if Is_Modular_Integer_Type (T) then Set_Ekind (Def_Id, E_Modular_Integer_Subtype); @@ -13382,7 +13383,6 @@ package body Sem_Ch3 is else pragma Assert (No (C)); Set_Scalar_Range (Def_Id, Scalar_Range (T)); - end if; Set_Discrete_RM_Size (Def_Id); @@ -20188,9 +20188,9 @@ package body Sem_Ch3 is (Hi, Related_Id => Subtyp, Is_High_Bound => True); end if; - -- We use a flag here instead of suppressing checks on the - -- type because the type we check against isn't necessarily - -- the place where we put the check. + -- We use a flag here instead of suppressing checks on the type + -- because the type we check against isn't necessarily the place + -- where we put the check. if not R_Check_Off then R_Checks := Get_Range_Checks (R, T); diff --git a/gcc/ada/style.adb b/gcc/ada/style.adb index d3f2d2c99cc..e58d5052d70 100644 --- a/gcc/ada/style.adb +++ b/gcc/ada/style.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2015, 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- -- @@ -264,10 +264,13 @@ package body Style is begin -- Perform the check on source subprograms and on subprogram instances, -- because these can be primitives of untagged types. Note that such - -- indicators were introduced in Ada 2005. + -- indicators were introduced in Ada 2005. We apply Comes_From_Source + -- to Original_Node to catch the case of a procedure body declared with + -- "is null" that has been rewritten as a normal empty body. if Style_Check_Missing_Overriding - and then (Comes_From_Source (N) or else Is_Generic_Instance (E)) + and then (Comes_From_Source (Original_Node (N)) + or else Is_Generic_Instance (E)) and then Ada_Version_Explicit >= Ada_2005 then -- If the subprogram is an instantiation, its declaration appears -- 2.30.2