From 0489576ce8062475a2a90b3aae869166d9005460 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 20 Oct 2015 11:55:20 +0200 Subject: [PATCH] [multiple changes] 2015-10-20 Hristian Kirtchev * sem_prag.adb (Check_Usage): Update the calls to Usage_Error. (Usage_Error): Remove formal parameter Item. Emit a clearer message concerning a missing dependency item and place it on the related pragma. 2015-10-20 Bob Duff * debug.adb, expander.adb: Implement -gnatd.B switch, which triggers a bug box when an abort_statement is seen. This is useful for testing Comperr.Compiler_Abort. * gnat1drv.adb: Trigger bug box on all exceptions other than Unrecoverable_Error. From-SVN: r229032 --- gcc/ada/ChangeLog | 14 ++++++++++++++ gcc/ada/debug.adb | 9 ++++++++- gcc/ada/expander.adb | 14 +++++++++++++- gcc/ada/gnat1drv.adb | 6 ++++++ gcc/ada/sem_prag.adb | 16 ++++++++-------- 5 files changed, 49 insertions(+), 10 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f3e3d66..2da6c04 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2015-10-20 Hristian Kirtchev + + * sem_prag.adb (Check_Usage): Update the calls to Usage_Error. + (Usage_Error): Remove formal parameter Item. Emit a clearer message + concerning a missing dependency item and place it on the related pragma. + +2015-10-20 Bob Duff + + * debug.adb, expander.adb: Implement -gnatd.B switch, which + triggers a bug box when an abort_statement is seen. This is + useful for testing Comperr.Compiler_Abort. + * gnat1drv.adb: Trigger bug box on all exceptions other than + Unrecoverable_Error. + 2015-10-20 Thomas Quinot * Makefile.rtl: add the following... diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index a8e0ff4..2bc09db 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -119,7 +119,7 @@ package body Debug is -- d.z Restore previous support for frontend handling of Inline_Always -- d.A Read/write Aspect_Specifications hash table to tree - -- d.B + -- d.B Generate a bug box on abort_statement -- d.C Generate concatenation call, do not generate inline code -- d.D Disable errors on use of overriding keyword in Ada 95 mode -- d.E Turn selected errors into warnings @@ -595,6 +595,13 @@ package body Debug is -- for now, this is controlled by the debug flag d.A. The hash table -- is only written and read if this flag is set. + -- d.B Generate a bug box when we see an abort_statement, even though + -- there is no bug. Useful for testing Comperr.Compiler_Abort: write + -- some code containing an abort_statement, and compile it with + -- -gnatd.B. There is nothing special about abort_statements; it just + -- provides a way to control where the bug box is generated. See "when + -- N_Abort_Statement" in package body Expander. + -- d.C Generate call to System.Concat_n.Str_Concat_n routines in cases -- where we would normally generate inline concatenation code. diff --git a/gcc/ada/expander.adb b/gcc/ada/expander.adb index ff19759..2d9b6d9 100644 --- a/gcc/ada/expander.adb +++ b/gcc/ada/expander.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, 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- -- @@ -24,6 +24,7 @@ ------------------------------------------------------------------------------ with Atree; use Atree; +with Debug; use Debug; with Debug_A; use Debug_A; with Exp_Aggr; use Exp_Aggr; with Exp_SPARK; use Exp_SPARK; @@ -67,6 +68,10 @@ package body Expander is Table_Increment => 200, Table_Name => "Expander_Flags"); + Abort_Bug_Box_Error : exception; + -- Arbitrary exception to raise for implementation of -gnatd.B. See "when + -- N_Abort_Statement" below. See also debug.adb. + ------------ -- Expand -- ------------ @@ -150,6 +155,13 @@ package body Expander is when N_Abort_Statement => Expand_N_Abort_Statement (N); + -- If -gnatd.B switch was given, crash the compiler. See + -- debug.adb for explanation. + + if Debug_Flag_Dot_BB then + raise Abort_Bug_Box_Error; + end if; + when N_Accept_Statement => Expand_N_Accept_Statement (N); diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 6b2046d..2284caf 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -1421,6 +1421,12 @@ begin -- say Storage_Error, giving a strong hint. Comperr.Compiler_Abort ("Storage_Error"); + + when Unrecoverable_Error => + raise; + + when others => + Comperr.Compiler_Abort ("exception"); end; <> diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 41763de..56c9bd7 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -1220,14 +1220,14 @@ package body Sem_Prag is Used_Items : Elist_Id; Is_Input : Boolean) is - procedure Usage_Error (Item : Node_Id; Item_Id : Entity_Id); + procedure Usage_Error (Item_Id : Entity_Id); -- Emit an error concerning the illegal usage of an item ----------------- -- Usage_Error -- ----------------- - procedure Usage_Error (Item : Node_Id; Item_Id : Entity_Id) is + procedure Usage_Error (Item_Id : Entity_Id) is Error_Msg : Name_Id; begin @@ -1245,10 +1245,10 @@ package body Sem_Prag is Add_Item_To_Name_Buffer (Item_Id); Add_Str_To_Name_Buffer - (" & must appear in at least one input dependence list"); + (" & is missing from input dependence list"); Error_Msg := Name_Find; - SPARK_Msg_NE (Get_Name_String (Error_Msg), Item, Item_Id); + SPARK_Msg_NE (Get_Name_String (Error_Msg), N, Item_Id); end if; -- Output case (SPARK RM 6.1.5(10)) @@ -1258,10 +1258,10 @@ package body Sem_Prag is Add_Item_To_Name_Buffer (Item_Id); Add_Str_To_Name_Buffer - (" & must appear in exactly one output dependence list"); + (" & is missing from output dependence list"); Error_Msg := Name_Find; - SPARK_Msg_NE (Get_Name_String (Error_Msg), Item, Item_Id); + SPARK_Msg_NE (Get_Name_String (Error_Msg), N, Item_Id); end if; end Usage_Error; @@ -1297,13 +1297,13 @@ package body Sem_Prag is and then not Contains (Used_Items, Item_Id) then if Is_Formal (Item_Id) then - Usage_Error (Item, Item_Id); + Usage_Error (Item_Id); -- States and global objects are not used properly only when -- the subprogram is subject to pragma Global. elsif Global_Seen then - Usage_Error (Item, Item_Id); + Usage_Error (Item_Id); end if; end if; -- 2.7.4