File: dbf\testing.adb

    1 --::::::::::
    2 --testing.adb
    3 --::::::::::
    4 -- Developed by (C) Wasiliy W. Molostoff 1994, 1995.
    5 --                  Moscow, Russia,
    6 --                  Voice:   7 (095) 398-23-38
    7 --                  e-mail:  edv@edv.msk.ru
    8 -- This is free software; you can  freely  redistribute  it  and/or
    9 -- modify  it  without any restrictions.  Please report any errors.
   10 -- All corrections will be made as soon as possible.
   11 with program_log, io_exceptions;
   12 use  io_exceptions;
   13 package body testing is
   14 
   15     function again return boolean is
   16 
   17         package log is new program_log (program_name, "try");
   18         use log;
   19 
   20         function report (ename : string) return boolean is
   21         begin
   22             error   ("alarm: " & ename);
   23             warning ("*** test failed ***");
   24             return false;
   25         end report;
   26 
   27     begin
   28 
   29       assert (program, "false: " & description,
   30                        " true: " & description);
   31       return true;
   32 
   33     exception
   34 
   35       when assertion_failed => return report ("assertion alarm");
   36 
   37       when constraint_error => return report ("Constraint Error");
   38       when program_error =>    return report ("Program    Error");
   39       when storage_error =>    return report ("Storage    Error");
   40       when tasking_error =>    return report ("Tasking    Error");
   41 
   42       when status_error  =>    return report ("Status     Error");
   43       when mode_error    =>    return report ("Mode       Error");
   44       when name_error    =>    return report ("Name       Error");
   45       when use_error     =>    return report ("Use        Error");
   46       when device_error  =>    return report ("Device     Error");
   47       when end_error     =>    return report ("End        Error");
   48       when data_error    =>    return report ("Data       Error");
   49 
   50 --      when numeric_error =>  return report ("Numeric    Error");
   51       when others =>         error   ("alarm: <NAME UNKNOWN>");
   52                              warning ("*** test failed ***");
   53                              raise;
   54    end again;
   55 
   56 begin
   57    if again then null; end if;
   58 end testing;
   59