Пакет Ada.Exceptions

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                       A D A . E X C E P T I O N S                        --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--                            $Revision: 1.14 $                             --
--                                                                          --
-- This specification is adapted from the Ada Reference Manual for use with --
-- GNAT.  In accordance with the copyright of that document, you can freely --
-- copy and modify this specification,  provided that if you redistribute a --
-- modified version,  any changes that you have made are clearly indicated. --
--                                                                          --

------------------------------------------------------------------------------
with Ada.Streams;

with System.Standard_Library;

package Ada.Exceptions is
   type Exception_Id is private;

   Null_Id : constant Exception_Id;
   type Exception_Occurrence is limited private;

   type Exception_Occurrence_Access is access all Exception_Occurrence;

   Null_Occurrence : constant Exception_Occurrence;
   --  Note: we altered the order to simplify the processing for the intrinsic
   --  routine Exception_Name, which needs to call the Exception_Occurrence
   --  version of the routine here, and Rtsfind will find the first matching

   --  occurrence when we have overloaded routines.
   function Exception_Identity (X : Exception_Occurrence) return Exception_Id;
   function Exception_Name     (X : Exception_Occurrence) return String;

   --  Same as Exception_Name (Exception_Identity (X))

   function Exception_Name (X : Exception_Id) return String;
   procedure Raise_Exception (E : in Exception_Id; Message : in String := "");
   function  Exception_Message    (X : Exception_Occurrence) return String;

   procedure Reraise_Occurrence   (X : Exception_Occurrence);

   function Exception_Information (X : Exception_Occurrence) return String;
   procedure Save_Occurrence
     (Target :    out Exception_Occurrence;

      Source : in     Exception_Occurrence);
   function Save_Occurrence
     (Source : in Exception_Occurrence)

      return Exception_Occurrence_Access;
private

   package SSL renames System.Standard_Library;
   type Exception_Id is access all SSL.Exception_Data;

   Null_Id : constant Exception_Id := null;
   subtype Nat is Natural range 0 .. SSL.Exception_Message_Buffer'Last;
   --  ??? replace Nat by Natural when limited types with discriminants

   --  are implemented properly
   --  Exception_Occurrence is defined as a limited record so that when a
   --  default instance is allocated, the default discriminant value is used
   --  to determine the length (given that even the full view is limited, we

   --  do not need to allocate the maximum length).
   type Exception_Occurrence
     (Max_Length : Nat := SSL.Exception_Msg_Max)
   is limited record
      Id         : Exception_Id;
      Msg_Length : Natural;
      Msg        : String (1 .. Max_Length);

   end record;
   procedure Set_Exception_Occurrence (Occ : Exception_Occurrence_Access);
   pragma Export (C, Set_Exception_Occurrence, "__set_except_occ");
   --  Procedure called directly by gigi to copy in the exception occurrence

   --  the exception message kept in the task-Specific data.
   --  Note: the whole issue of stream attributes and exception occurrences
   --  is rather mixed up. We implement 'Read and 'Write as required in the
   --  RM, with the addition that Read is allowed to truncate a long message

   --  to the allowed 200 characters (just like Save_Occurrence).
   procedure Exception_Occurrence_Read
     (Stream : access Ada.Streams.Root_Stream_Type'Class;

      Item   : out Exception_Occurrence);
   procedure Exception_Occurrence_Write
     (Stream : access Ada.Streams.Root_Stream_Type'Class;

      Item   : in Exception_Occurrence);
   for Exception_Occurrence'Read  use Exception_Occurrence_Read;

   for Exception_Occurrence'Write use Exception_Occurrence_Write;
   --  We do not implement 'Input and 'Output for Exception_Occurrence,
   --  since they are not required, and 'Input in particular is not easy
   --  to implement (more properly is impossible), since there is no way
   --  to write a 'Input function for a limited record that does not have

   --  a serious storage leak problem.
   --  Instead, analogous to how Save_Occurrence works, we implement a
   --  special 'Input routine for Exception_Occurrence_Access that returns
   --  a pointer to an Exception_Occurrence that can hold a message of any

   --  length as originally written by Exception_Occurrence'Write.
   function Exception_Occurrence_Access_Input
     (Stream : access Ada.Streams.Root_Stream_Type'Class)

      return   Exception_Occurrence_Access;

   for Exception_Occurrence_Access'Input use Exception_Occurrence_Access_Input;
   --  Note: the following definition of Null_Occurrence is not legal Ada. In
   --  fact, given the clear requirement to make Exception_Occurrence a limited
   --  record (see above note), there is no way to complete Null_Occurrence in
   --  a legal way. There is a special kludge in the compiler to permit this

   --  particular bit of illegal Ada!
   Null_Occurrence : constant Exception_Occurrence := (
     Max_Length => 0,
     Id         => Null_Id,
     Msg_Length => 0,

     Msg        => "");
end Ada.Exceptions;