1(* Ulm's Oberon Library
2   Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
3   ----------------------------------------------------------------------------
4   Ulm's Oberon Library is free software; you can redistribute it
5   and/or modify it under the terms of the GNU Library General Public
6   License as published by the Free Software Foundation; either version
7   2 of the License, or (at your option) any later version.
8
9   Ulm's Oberon Library is distributed in the hope that it will be
10   useful, but WITHOUT ANY WARRANTY; without even the implied warranty
11   of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
12   Library General Public License for more details.
13
14   You should have received a copy of the GNU Library General Public
15   License along with this library; if not, write to the Free Software
16   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
17   ----------------------------------------------------------------------------
18   E-mail contact: oberon@mathematik.uni-ulm.de
19   ----------------------------------------------------------------------------
20   $Id: Assertions.om,v 1.2 1996/01/04 16:50:59 borchert Exp $
21   ----------------------------------------------------------------------------
22   $Log: Assertions.om,v $
23   Revision 1.2  1996/01/04  16:50:59  borchert
24   some fixes because event types are now an extension of Services.Object
25
26   Revision 1.1  1994/02/22  20:06:01  borchert
27   Initial revision
28
29   ----------------------------------------------------------------------------
30   AFB 11/91
31   ----------------------------------------------------------------------------
32*)
33
34MODULE ulmAssertions;
35
36   (* general error handling of library routines *)
37
38   IMPORT Disciplines := ulmDisciplines, Events := ulmEvents, IO := ulmIO, Priorities := ulmPriorities, RelatedEvents := ulmRelatedEvents, Services := ulmServices, Types := ulmTypes;
39
40   TYPE
41      Object = Disciplines.Object;
42      Identifier* = ARRAY 32 OF CHAR; (* should be sufficient *)
43      Event* = POINTER TO EventRec;
44      EventRec* =
45	 RECORD
46	    (Events.EventRec)
47	    object*: Object;      (* may be NIL *)
48	    module*: Identifier;
49	    proc*: Identifier;
50	 END;
51      EventType = POINTER TO EventTypeRec;
52      EventTypeRec* =
53	 RECORD
54	    (Events.EventTypeRec)
55	    (* private components *)
56	    module: Identifier;
57	 END;
58
59   VAR
60      failedAssertion*: Events.EventType;
61      eventTypeType: Services.Type;
62
63   PROCEDURE Define*(VAR type: Events.EventType; module: ARRAY OF CHAR);
64      (* create a new event type which will be of type Assertions.EventType *)
65      VAR
66	 newtype: EventType;
67   BEGIN
68      NEW(newtype);
69      Services.Init(newtype, eventTypeType);
70      Events.Init(newtype);
71      Events.SetPriority(newtype, Priorities.assertions);
72      COPY(module, newtype.module);
73      type := newtype;
74   END Define;
75
76   PROCEDURE Raise*(object: RelatedEvents.Object;
77		   type: Events.EventType;
78		   proc: ARRAY OF CHAR;
79		   text: ARRAY OF CHAR);
80      (* raise Assertions.failedAssertion;
81	 create a event of the given type and pass it
82	 to RelatedEvents.Raise (if object # NIL)
83	 or Events.Raise (if object = NIL);
84      *)
85      VAR
86	 event: Event;
87
88      PROCEDURE CreateEvent(VAR event: Event; etype: Events.EventType);
89      BEGIN
90	 NEW(event);
91	 event.type := etype;
92	 COPY(text, event.message);
93	 event.object := object;
94	 IF type IS EventType THEN
95	    COPY(type(EventType).module, event.module);
96	 ELSE
97	    event.module[0] := 0X;
98	 END;
99	 COPY(proc, event.proc);
100      END CreateEvent;
101
102   BEGIN
103      IO.WriteString("assertion failed: ");
104      IO.WriteString(text); IO.WriteString(" in procedure ");
105      IO.WriteString(proc); IO.WriteLn;
106      CreateEvent(event, failedAssertion); Events.Raise(event);
107      CreateEvent(event, type);
108      IF object = NIL THEN
109	 Events.Raise(event);
110      ELSE
111	 RelatedEvents.Raise(object, event);
112      END;
113   END Raise;
114
115BEGIN
116   Events.Define(failedAssertion);
117   Events.SetPriority(failedAssertion, Priorities.assertions);
118   Events.Ignore(failedAssertion);
119   Services.CreateType(eventTypeType,
120      "Assertions.EventType", "Events.EventType");
121END ulmAssertions.
122