From 8453782c2b508a3c18474bf6626f31ba3e21c968 Mon Sep 17 00:00:00 2001 From: charlet Date: Wed, 26 Mar 2008 07:40:04 +0000 Subject: 2008-03-26 Robert Dewar * 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@133568 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/g-pehage.adb | 10 +++------- gcc/ada/g-regist.adb | 7 ++----- gcc/ada/g-spipat.adb | 11 ++++------- gcc/ada/g-spipat.ads | 8 +++++++- gcc/ada/s-asthan.adb | 18 +++--------------- gcc/ada/s-parint.adb | 5 ++--- gcc/ada/s-rpc.adb | 16 ++++++---------- gcc/ada/s-stchop.adb | 10 ++-------- 8 files changed, 29 insertions(+), 56 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/g-pehage.adb b/gcc/ada/g-pehage.adb index 6d9670f69f8..f64181e1eb8 100644 --- a/gcc/ada/g-pehage.adb +++ b/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 diff --git a/gcc/ada/g-regist.adb b/gcc/ada/g-regist.adb index ec0d974e743..8eaa4081bbc 100644 --- a/gcc/ada/g-regist.adb +++ b/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; diff --git a/gcc/ada/g-spipat.adb b/gcc/ada/g-spipat.adb index 0e56f8ac409..1e0c85c22c4 100644 --- a/gcc/ada/g-spipat.adb +++ b/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; ------------ diff --git a/gcc/ada/g-spipat.ads b/gcc/ada/g-spipat.ads index fd1281c8ce7..af4aed19f57 100644 --- a/gcc/ada/g-spipat.ads +++ b/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 -- -------------------------------- diff --git a/gcc/ada/s-asthan.adb b/gcc/ada/s-asthan.adb index 00df7f45b16..bb3ac693df4 100644 --- a/gcc/ada/s-asthan.adb +++ b/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; diff --git a/gcc/ada/s-parint.adb b/gcc/ada/s-parint.adb index f8bcdcc0bb8..622c2d01062 100644 --- a/gcc/ada/s-parint.adb +++ b/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; ----------------- diff --git a/gcc/ada/s-rpc.adb b/gcc/ada/s-rpc.adb index a812423142d..2fa936761ea 100644 --- a/gcc/ada/s-rpc.adb +++ b/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; diff --git a/gcc/ada/s-stchop.adb b/gcc/ada/s-stchop.adb index aacdad94708..e403bc9b15a 100644 --- a/gcc/ada/s-stchop.adb +++ b/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; -- cgit v1.2.1