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