[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Tue, 20 Oct 2015 09:55:20 +0000 (11:55 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Tue, 20 Oct 2015 09:55:20 +0000 (11:55 +0200)
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

gcc/ada/ChangeLog
gcc/ada/debug.adb
gcc/ada/expander.adb
gcc/ada/gnat1drv.adb
gcc/ada/sem_prag.adb

index f3e3d66344b867606c4df9428c8922c15b63867a..2da6c0452ffdf200d743189d4a285b3da0e41606 100644 (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...
index a8e0ff4c02213cc9a2ee172c6aa29f7c70429aa2..2bc09db871005ace6ad00543f175125ec58c4f5d 100644 (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.
 
index ff1975955dc72dacd0657bcc5b8ab0c75fb8733f..2d9b6d964acfa7bd3bc59586e7402a486f85b247 100644 (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);
 
index 6b2046ddcd9344229ccfca6bf2a533d13361c16b..2284caf8c90b61dff98785cdeccda155c20457aa 100644 (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>>
index 41763de72ecb81555b8762e8e01d5820b9dbeed0..56c9bd7003075c6b825df3cc0e03c761c3352305 100644 (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;