File : bc-support-exceptions.adb
-- Copyright (C) 1998 Grady Booch and Simon Wright.
-- All Rights Reserved.
--
-- This program is free software; you can redistribute it
-- and/or modify it under the terms of the Ada Community
-- License which comes with this Library.
--
-- This program is distributed in the hope that it will be
-- useful, but WITHOUT ANY WARRANTY; without even the implied
-- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
-- PURPOSE. See the Ada Community License for more details.
-- You should have received a copy of the Ada Community
-- License with this library, in the file named "Ada Community
-- License" or "ACL". If not, contact the author of this library
-- for a copy.
--
-- $Id: bc-support-exceptions.adb,v 1.3 1998/09/20 12:56:11 simon Exp $
package body BC.Support.Exceptions is
function Reason_Message (For_The_Reason : Reason) return String is
begin
case For_The_Reason is
when No_Reason_Given => return "";
when Disjoint => return "objects are members of different structures";
when Duplicate => return "object already exists";
when Empty => return "object is empty";
when Full => return "object is full";
when Illegal => return "illegal pattern";
when Invalid_Index => return "index is out of range";
when Invalid_Number => return "string does not denote a valid number";
when Missing => return "object does not exist";
when Not_Empty => return "object is not empty";
when Not_Root => return "object is not at root of structure";
when Is_Null => return "object is null";
when Out_Of_Memory => return "storage requested not available";
when Referenced => return "object is referenced and cannot be destroyed";
when Timing => return "possible race condition";
when Too_Large => return "object is too large";
when Too_Small => return "object is too small";
end case;
end Reason_Message;
procedure Assert (Condition : Boolean;
Raising_If_False : Ada.Exceptions.Exception_Id;
From_Subprogram : String;
With_Reason : Reason := No_Reason_Given) is
begin
if not Condition then
if With_Reason = No_Reason_Given then
Ada.Exceptions.Raise_Exception
(Raising_If_False,
Module & "." & From_Subprogram);
else
Ada.Exceptions.Raise_Exception
(Raising_If_False,
Module & "." & From_Subprogram & ": "
& Reason_Message (With_Reason));
end if;
end if;
end Assert;
procedure Report (The_Exception : Ada.Exceptions.Exception_Occurrence;
To : Ada.Text_Io.File_Type := Ada.Text_Io.Standard_Output) is
begin
if Ada.Exceptions.Exception_Message (The_Exception)'Length = 0 then
Ada.Text_Io.Put_Line (File => To,
Item => "Exception "
& Ada.Exceptions.Exception_Name (The_Exception)
& " occurred.");
else
Ada.Text_Io.Put_Line (File => To,
Item => "Exception "
& Ada.Exceptions.Exception_Name (The_Exception)
& " ("
& Ada.Exceptions.Exception_Message (The_Exception)
& ") occurred.");
end if;
end Report;
end BC.Support.Exceptions;