[Ada] Replace use of Ada.Exceptions.Raise_Exception
Arnaud Charlet
charlet@adacore.com
Fri Mar 28 10:35:00 GMT 2008
Tested on i686-linux, committed on trunk
This patch replaces the use of Ada.Exceptions.Raise_Exception
with the new Ada 2005 "raise with" form. This is not done in
units that are part of the compiler to avoid problems with
bootstrapping.
No test, since no change in functional behavior, this is
just a cleanup.
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.
-------------- next part --------------
Index: g-pehage.adb
===================================================================
--- g-pehage.adb (revision 133430)
+++ g-pehage.adb (working copy)
@@ -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_Generator
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_Generator
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_Generator
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: g-regist.adb
===================================================================
--- g-regist.adb (revision 133430)
+++ g-regist.adb (working copy)
@@ -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;
Index: g-spipat.ads
===================================================================
--- g-spipat.ads (revision 133430)
+++ g-spipat.ads (working copy)
@@ -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: g-spipat.adb
===================================================================
--- g-spipat.adb (revision 133430)
+++ g-spipat.adb (working copy)
@@ -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: s-asthan.adb
===================================================================
--- s-asthan.adb (revision 133430)
+++ s-asthan.adb (working copy)
@@ -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;
Index: s-parint.adb
===================================================================
--- s-parint.adb (revision 133430)
+++ s-parint.adb (working copy)
@@ -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
(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: s-rpc.adb
===================================================================
--- s-rpc.adb (revision 133430)
+++ s-rpc.adb (working copy)
@@ -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: s-stchop.adb
===================================================================
--- s-stchop.adb (revision 133430)
+++ s-stchop.adb (working copy)
@@ -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.Opera
(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.Opera
(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;
More information about the Gcc-patches
mailing list