[multiple changes]

2015-10-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* 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  <duff@adacore.com>

	* 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
This commit is contained in:
Arnaud Charlet 2015-10-20 11:55:20 +02:00
parent 3c777b50a7
commit 0489576ce8
5 changed files with 49 additions and 10 deletions

View File

@ -1,3 +1,17 @@
2015-10-20 Hristian Kirtchev <kirtchev@adacore.com>
* 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 <duff@adacore.com>
* 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 <quinot@adacore.com>
* Makefile.rtl: add the following...

View File

@ -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.

View File

@ -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);

View File

@ -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;
<<End_Of_Program>>

View File

@ -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;