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