Commit 4e9f48a1 by Robert Dewar Committed by Arnaud Charlet

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
parent 944f7f28
......@@ -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
......
......@@ -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;
......
......@@ -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;
------------
......
......@@ -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 --
--------------------------------
......
......@@ -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;
......@@ -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;
-----------------
......
......@@ -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;
......
......@@ -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;
......
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