g-pehage.adb, [...]: Replace Raise_Exception by "raise with" construct.
authorRobert Dewar <dewar@adacore.com>
Wed, 26 Mar 2008 07:40:04 +0000 (08:40 +0100)
committerArnaud Charlet <charlet@gcc.gnu.org>
Wed, 26 Mar 2008 07:40:04 +0000 (08:40 +0100)
2008-03-26  Robert Dewar  <dewar@adacore.com>

* g-pehage.adb, g-regist.adb, g-spipat.ads, g-spipat.adb,
s-asthan.adb, s-parint.adb, s-rpc.adb, s-stchop.adb: Replace
Raise_Exception by "raise with" construct.

From-SVN: r133568

gcc/ada/g-pehage.adb
gcc/ada/g-regist.adb
gcc/ada/g-spipat.adb
gcc/ada/g-spipat.ads
gcc/ada/s-asthan.adb
gcc/ada/s-parint.adb
gcc/ada/s-rpc.adb
gcc/ada/s-stchop.adb

index 6d9670f69f8ce19991cb4ca94989e641d0c514bc..f64181e1eb8c4f205f190486134bd4e9975f3f0b 100644 (file)
@@ -31,7 +31,6 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with Ada.Exceptions;    use Ada.Exceptions;
 with Ada.IO_Exceptions; use Ada.IO_Exceptions;
 
 with GNAT.Heap_Sort_G;
@@ -1218,8 +1217,7 @@ package body GNAT.Perfect_Hash_Generators is
          end if;
 
          if C not in '0' .. '9' then
-            Raise_Exception
-              (Program_Error'Identity, "cannot read position argument");
+            raise Program_Error with "cannot read position argument";
          end if;
 
          while C in '0' .. '9' loop
@@ -1271,8 +1269,7 @@ package body GNAT.Perfect_Hash_Generators is
             exit when L < N;
 
             if Argument (N) /= ',' then
-               Raise_Exception
-                 (Program_Error'Identity, "cannot read position argument");
+               raise Program_Error with "cannot read position argument";
             end if;
 
             N := N + 1;
@@ -2184,8 +2181,7 @@ package body GNAT.Perfect_Hash_Generators is
             end loop;
 
             if Old_Differences = Max_Differences then
-               Raise_Exception
-                 (Program_Error'Identity, "some keys are identical");
+               raise Program_Error with "some keys are identical";
             end if;
 
             --  Insert selected position and sort Sel_Position table
index ec0d974e743c414a84c1bcac6505fbf5c7534673..8eaa4081bbc515f0b4949318427d9bd24b8cf2d8 100644 (file)
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with Ada.Exceptions;
 with Interfaces.C;
 with System;
 with GNAT.Directory_Operations;
 
 package body GNAT.Registry is
 
-   use Ada;
    use System;
 
    ------------------------------
@@ -156,9 +154,8 @@ package body GNAT.Registry is
       use type LONG;
    begin
       if Result /= ERROR_SUCCESS then
-         Exceptions.Raise_Exception
-           (Registry_Error'Identity,
-            Message & " (" & LONG'Image (Result) & ')');
+         raise Registry_Error with
+           Message & " (" & LONG'Image (Result) & ')';
       end if;
    end Check_Result;
 
index 0e56f8ac409b5ba1b14ea498def32ff67a01c051..1e0c85c22c43f0c9e214370cdec9ad607b419531 100644 (file)
@@ -36,7 +36,6 @@
 --  a direct translation, but the approach is followed closely. In particular,
 --  we use the one stack approach developed in the SPITBOL implementation.
 
-with Ada.Exceptions;            use Ada.Exceptions;
 with Ada.Strings.Unbounded.Aux; use Ada.Strings.Unbounded.Aux;
 
 with GNAT.Debug_Utilities;      use GNAT.Debug_Utilities;
@@ -2782,9 +2781,8 @@ package body GNAT.Spitbol.Patterns is
 
    procedure Logic_Error is
    begin
-      Raise_Exception
-        (Program_Error'Identity,
-         "Internal logic error in GNAT.Spitbol.Patterns");
+      raise Program_Error with
+         "Internal logic error in GNAT.Spitbol.Patterns";
    end Logic_Error;
 
    -----------
@@ -3644,9 +3642,8 @@ package body GNAT.Spitbol.Patterns is
 
    procedure Uninitialized_Pattern is
    begin
-      Raise_Exception
-        (Program_Error'Identity,
-         "uninitialized value of type GNAT.Spitbol.Patterns.Pattern");
+      raise Program_Error with
+         "uninitialized value of type GNAT.Spitbol.Patterns.Pattern";
    end Uninitialized_Pattern;
 
    ------------
index fd1281c8ce70d63d39e82d4beddf8e028f98c945..af4aed19f571c2fb3375c5a866e401928c62e62e 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                     Copyright (C) 1997-2006, AdaCore                     --
+--                     Copyright (C) 1997-2007, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -693,6 +693,12 @@ package GNAT.Spitbol.Patterns is
    --  body, manage to interprete them properly as though they were indeed
    --  in out parameters.
 
+   pragma Warnings (Off, VString_Var);
+   pragma Warnings (Off, Pattern_Var);
+   --  We turn off warnings for these two types so that when variables are used
+   --  as arguments in this context, warnings about them not being assigned in
+   --  the source program will be suppressed.
+
    --------------------------------
    -- Basic Pattern Construction --
    --------------------------------
index 00df7f45b167dabca50277778416a0fa734bdaf0..bb3ac693df440e4beaf1fb78a3122dd953170d26 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1996-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1996-2007, 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- --
 
 --  This is the dummy version used on non-VMS systems
 
-with Ada.Exceptions;
-
 package body System.AST_Handling is
 
-   pragma Warnings (Off); -- kill warnings on unreferenced formals
-
    ------------------------
    -- Create_AST_Handler --
    ------------------------
@@ -48,10 +44,7 @@ package body System.AST_Handling is
       Entryno : Natural) return System.Aux_DEC.AST_Handler
    is
    begin
-      Ada.Exceptions.Raise_Exception
-        (E       => Program_Error'Identity,
-         Message => "AST is implemented only on VMS systems");
-
+      raise Program_Error with "AST is implemented only on VMS systems";
       return System.Aux_DEC.No_AST_Handler;
    end Create_AST_Handler;
 
@@ -61,12 +54,7 @@ package body System.AST_Handling is
       Total_Number      : out Natural)
    is
    begin
-      Ada.Exceptions.Raise_Exception
-        (E       => Program_Error'Identity,
-         Message => "AST is implemented only on VMS systems");
-
-      Actual_Number := 0;
-      Total_Number := 0;
+      raise Program_Error with "AST is implemented only on VMS systems";
    end Expand_AST_Packet_Pool;
 
 end System.AST_Handling;
index f8bcdcc0bb88eda00801e00c787fecb3ad2ca493..622c2d0106273a6a5e3610fdef3f8b0b6d018ca1 100644 (file)
@@ -7,7 +7,7 @@
 --                                  B o d y                                 --
 --                   (Dummy body for non-distributed case)                  --
 --                                                                          --
---          Copyright (C) 1995-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1995-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL 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- --
@@ -215,8 +215,7 @@ package body System.Partition_Interface is
      (E : Ada.Exceptions.Exception_Occurrence)
    is
    begin
-      Ada.Exceptions.Raise_Exception
-        (Program_Error'Identity, Ada.Exceptions.Exception_Message (E));
+      raise Program_Error with Ada.Exceptions.Exception_Message (E);
    end Raise_Program_Error_Unknown_Tag;
 
    -----------------
index a812423142d04de572450e89211fa8db040a5b09..2fa936761ea5b807e3dbe38a42367efabad0dd04 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, 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- --
@@ -39,8 +39,6 @@
 
 --  The GLADE distribution package includes a replacement for this file
 
-with Ada.Exceptions; use Ada.Exceptions;
-
 package body System.RPC is
 
    CRLF : constant String := ASCII.CR & ASCII.LF;
@@ -49,9 +47,6 @@ package body System.RPC is
            CRLF & "Distribution support not installed in your environment" &
            CRLF & "For information on GLADE, contact Ada Core Technologies";
 
-   pragma Warnings (Off);
-   --  Kill messages about out parameters not set
-
    ----------
    -- Read --
    ----------
@@ -62,7 +57,7 @@ package body System.RPC is
       Last   : out Ada.Streams.Stream_Element_Offset)
    is
    begin
-      Raise_Exception (Program_Error'Identity, Msg);
+      raise Program_Error with Msg;
    end Read;
 
    -----------
@@ -74,7 +69,7 @@ package body System.RPC is
       Item   : Ada.Streams.Stream_Element_Array)
    is
    begin
-      Raise_Exception (Program_Error'Identity, Msg);
+      raise Program_Error with Msg;
    end Write;
 
    ------------
@@ -87,7 +82,7 @@ package body System.RPC is
       Result    : access Params_Stream_Type)
    is
    begin
-      Raise_Exception (Program_Error'Identity, Msg);
+      raise Program_Error with Msg;
    end Do_RPC;
 
    ------------
@@ -99,7 +94,7 @@ package body System.RPC is
       Params    : access Params_Stream_Type)
    is
    begin
-      Raise_Exception (Program_Error'Identity, Msg);
+      raise Program_Error with Msg;
    end Do_APC;
 
    ----------------------------
@@ -110,6 +105,7 @@ package body System.RPC is
      (Partition : Partition_ID;
       Receiver  : RPC_Receiver)
    is
+      pragma Unreferenced (Partition, Receiver);
    begin
       null;
    end Establish_RPC_Receiver;
index aacdad9470825969760eb110b4fa41295c3fc08b..e403bc9b15aa6bb3c4075d6bc97a99776367b114 100644 (file)
@@ -39,8 +39,6 @@ pragma Restrictions (No_Elaboration_Code);
 --  We want to guarantee the absence of elaboration code because the
 --  binder does not handle references to this package.
 
-with Ada.Exceptions;
-
 with System.Storage_Elements; use System.Storage_Elements;
 with System.Parameters; use System.Parameters;
 with System.Soft_Links;
@@ -216,9 +214,7 @@ package body System.Stack_Checking.Operations is
          (not Stack_Grows_Down and then
             Stack_Address < Frame_Address)
       then
-         Ada.Exceptions.Raise_Exception
-           (E       => Storage_Error'Identity,
-            Message => "stack overflow detected");
+         raise Storage_Error with "stack overflow detected";
       end if;
 
       --  This function first does a "cheap" check which is correct
@@ -270,9 +266,7 @@ package body System.Stack_Checking.Operations is
             (not Stack_Grows_Down and then
                   Stack_Address > My_Stack.Limit)
          then
-            Ada.Exceptions.Raise_Exception
-              (E       => Storage_Error'Identity,
-               Message => "stack overflow detected");
+            raise Storage_Error with "stack overflow detected";
          end if;
 
          return My_Stack;