g-pehage.adb, [...]: Replace Raise_Exception by "raise with" construct.

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

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

gcc/ada/g-regist.adb

@@ -30,14 +30,12 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-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;
 

gcc/ada/g-spipat.adb

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

gcc/ada/g-spipat.ads

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

gcc/ada/s-asthan.adb

@@ -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- --
@@ -33,12 +33,8 @@
 
 --  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;

gcc/ada/s-parint.adb

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

gcc/ada/s-rpc.adb

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

gcc/ada/s-stchop.adb

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