File: dbf\system_log.adb

    1 --::::::::::
    2 --systelog.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 
   12 -- with extended_calendar;
   13 -- use  extended_calendar;
   14 with calendar;
   15 use  calendar;
   16 
   17 package body system_log is
   18 
   19    sep: constant string := ": ";
   20 
   21    procedure put_line (s: string) is separate;
   22 
   23    function image (moment: time) return string is
   24    begin
   25         -- unimplemented in this release
   26         return ""; -- timeimage (moment, " [%40:%50:%60]");
   27    end;
   28 
   29    procedure error (msg: string;
   30                  moment: time   := start_time;
   31                   owner: string := owner_name) is
   32    begin
   33        if moment /= start_time then
   34            put_line ("*** " & owner & image(moment) & sep & msg);
   35        else
   36            put_line ("*** " & owner & sep & msg);
   37        end if;
   38    end;
   39 
   40    procedure warning (msg: string;
   41                    moment: time   := start_time;
   42                     owner: string := owner_name) is
   43    begin
   44        if moment /= start_time then
   45            put_line ("+++ " & owner & image(moment) & sep & msg);
   46        else
   47            put_line ("+++ " & owner & sep & msg);
   48        end if;
   49    end;
   50 
   51    procedure message (msg: string;
   52                    moment: time   := start_time;
   53                     owner: string := owner_name) is
   54    begin
   55        if moment /= start_time then
   56            put_line ("--- " & owner & image(moment) & sep & msg);
   57        else
   58            put_line ("--- " & owner & sep & msg);
   59        end if;
   60    end;
   61 
   62    procedure assert (hypothesis: boolean;
   63                           false_msg: string := "";
   64                            true_msg: string := "";
   65                              moment: time   := start_time;
   66                               owner: string := owner_name) is
   67    begin
   68        if not hypothesis
   69        then
   70            if false_msg'length > 0
   71            then
   72                  error (false_msg, owner => owner);
   73            end if;
   74            raise assertion_failed;
   75        else
   76            if true_msg'length > 0
   77            then
   78                  message (true_msg, owner => owner);
   79            end if;
   80        end if;
   81    end;
   82 
   83 end system_log;
   84