Commit 0489576c by Arnaud Charlet

[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
parent 3c777b50
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> 2015-10-20 Thomas Quinot <quinot@adacore.com>
* Makefile.rtl: add the following... * Makefile.rtl: add the following...
......
...@@ -119,7 +119,7 @@ package body Debug is ...@@ -119,7 +119,7 @@ package body Debug is
-- d.z Restore previous support for frontend handling of Inline_Always -- d.z Restore previous support for frontend handling of Inline_Always
-- d.A Read/write Aspect_Specifications hash table to tree -- 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.C Generate concatenation call, do not generate inline code
-- d.D Disable errors on use of overriding keyword in Ada 95 mode -- d.D Disable errors on use of overriding keyword in Ada 95 mode
-- d.E Turn selected errors into warnings -- d.E Turn selected errors into warnings
...@@ -595,6 +595,13 @@ package body Debug is ...@@ -595,6 +595,13 @@ package body Debug is
-- for now, this is controlled by the debug flag d.A. The hash table -- for now, this is controlled by the debug flag d.A. The hash table
-- is only written and read if this flag is set. -- 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 -- d.C Generate call to System.Concat_n.Str_Concat_n routines in cases
-- where we would normally generate inline concatenation code. -- where we would normally generate inline concatenation code.
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -24,6 +24,7 @@ ...@@ -24,6 +24,7 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Atree; use Atree; with Atree; use Atree;
with Debug; use Debug;
with Debug_A; use Debug_A; with Debug_A; use Debug_A;
with Exp_Aggr; use Exp_Aggr; with Exp_Aggr; use Exp_Aggr;
with Exp_SPARK; use Exp_SPARK; with Exp_SPARK; use Exp_SPARK;
...@@ -67,6 +68,10 @@ package body Expander is ...@@ -67,6 +68,10 @@ package body Expander is
Table_Increment => 200, Table_Increment => 200,
Table_Name => "Expander_Flags"); 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 -- -- Expand --
------------ ------------
...@@ -150,6 +155,13 @@ package body Expander is ...@@ -150,6 +155,13 @@ package body Expander is
when N_Abort_Statement => when N_Abort_Statement =>
Expand_N_Abort_Statement (N); 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 => when N_Accept_Statement =>
Expand_N_Accept_Statement (N); Expand_N_Accept_Statement (N);
......
...@@ -1421,6 +1421,12 @@ begin ...@@ -1421,6 +1421,12 @@ begin
-- say Storage_Error, giving a strong hint. -- say Storage_Error, giving a strong hint.
Comperr.Compiler_Abort ("Storage_Error"); Comperr.Compiler_Abort ("Storage_Error");
when Unrecoverable_Error =>
raise;
when others =>
Comperr.Compiler_Abort ("exception");
end; end;
<<End_Of_Program>> <<End_Of_Program>>
......
...@@ -1220,14 +1220,14 @@ package body Sem_Prag is ...@@ -1220,14 +1220,14 @@ package body Sem_Prag is
Used_Items : Elist_Id; Used_Items : Elist_Id;
Is_Input : Boolean) Is_Input : Boolean)
is 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 -- Emit an error concerning the illegal usage of an item
----------------- -----------------
-- Usage_Error -- -- 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; Error_Msg : Name_Id;
begin begin
...@@ -1245,10 +1245,10 @@ package body Sem_Prag is ...@@ -1245,10 +1245,10 @@ package body Sem_Prag is
Add_Item_To_Name_Buffer (Item_Id); Add_Item_To_Name_Buffer (Item_Id);
Add_Str_To_Name_Buffer Add_Str_To_Name_Buffer
(" & must appear in at least one input dependence list"); (" & is missing from input dependence list");
Error_Msg := Name_Find; 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 if;
-- Output case (SPARK RM 6.1.5(10)) -- Output case (SPARK RM 6.1.5(10))
...@@ -1258,10 +1258,10 @@ package body Sem_Prag is ...@@ -1258,10 +1258,10 @@ package body Sem_Prag is
Add_Item_To_Name_Buffer (Item_Id); Add_Item_To_Name_Buffer (Item_Id);
Add_Str_To_Name_Buffer Add_Str_To_Name_Buffer
(" & must appear in exactly one output dependence list"); (" & is missing from output dependence list");
Error_Msg := Name_Find; 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 if;
end Usage_Error; end Usage_Error;
...@@ -1297,13 +1297,13 @@ package body Sem_Prag is ...@@ -1297,13 +1297,13 @@ package body Sem_Prag is
and then not Contains (Used_Items, Item_Id) and then not Contains (Used_Items, Item_Id)
then then
if Is_Formal (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 -- States and global objects are not used properly only when
-- the subprogram is subject to pragma Global. -- the subprogram is subject to pragma Global.
elsif Global_Seen then elsif Global_Seen then
Usage_Error (Item, Item_Id); Usage_Error (Item_Id);
end if; end if;
end if; end if;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment