-- --
------------------------------------------------------------------------------
-with Ada.Exceptions; use Ada.Exceptions;
with Ada.IO_Exceptions; use Ada.IO_Exceptions;
with GNAT.Heap_Sort_G;
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
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;
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
-- --
------------------------------------------------------------------------------
-with Ada.Exceptions;
with Interfaces.C;
with System;
with GNAT.Directory_Operations;
package body GNAT.Registry is
- use Ada;
use System;
------------------------------
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;
-- 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;
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;
-----------
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;
------------
-- --
-- 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- --
-- 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 --
--------------------------------
-- --
-- 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- --
-- 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 --
------------------------
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;
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;
-- 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- --
(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;
-----------------
-- --
-- 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- --
-- 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;
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 --
----------
Last : out Ada.Streams.Stream_Element_Offset)
is
begin
- Raise_Exception (Program_Error'Identity, Msg);
+ raise Program_Error with Msg;
end Read;
-----------
Item : Ada.Streams.Stream_Element_Array)
is
begin
- Raise_Exception (Program_Error'Identity, Msg);
+ raise Program_Error with Msg;
end Write;
------------
Result : access Params_Stream_Type)
is
begin
- Raise_Exception (Program_Error'Identity, Msg);
+ raise Program_Error with Msg;
end Do_RPC;
------------
Params : access Params_Stream_Type)
is
begin
- Raise_Exception (Program_Error'Identity, Msg);
+ raise Program_Error with Msg;
end Do_APC;
----------------------------
(Partition : Partition_ID;
Receiver : RPC_Receiver)
is
+ pragma Unreferenced (Partition, Receiver);
begin
null;
end Establish_RPC_Receiver;
-- 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;
(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
(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;