From 999a3baa33515e77e1816c088545e3c46e6714c5 Mon Sep 17 00:00:00 2001 From: Norayr Chilingarian Date: Tue, 22 Oct 2013 16:37:44 +0400 Subject: [PATCH] ulmAssertions, ulmIndirectDisciplines Former-commit-id: 26711501d038f3396de30c36a3bdebe8d86d502f --- src/lib/ulm/ulmAssertions.Mod | 121 ++++++++++++++++++++++++ src/lib/ulm/ulmIndirectDisciplines.Mod | 122 +++++++++++++++++++++++++ 2 files changed, 243 insertions(+) create mode 100644 src/lib/ulm/ulmAssertions.Mod create mode 100644 src/lib/ulm/ulmIndirectDisciplines.Mod diff --git a/src/lib/ulm/ulmAssertions.Mod b/src/lib/ulm/ulmAssertions.Mod new file mode 100644 index 00000000..0f6fe59e --- /dev/null +++ b/src/lib/ulm/ulmAssertions.Mod @@ -0,0 +1,121 @@ +(* Ulm's Oberon Library + Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany + ---------------------------------------------------------------------------- + Ulm's Oberon Library is free software; you can redistribute it + and/or modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either version + 2 of the License, or (at your option) any later version. + + Ulm's Oberon Library 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 GNU + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + ---------------------------------------------------------------------------- + E-mail contact: oberon@mathematik.uni-ulm.de + ---------------------------------------------------------------------------- + $Id: Assertions.om,v 1.2 1996/01/04 16:50:59 borchert Exp $ + ---------------------------------------------------------------------------- + $Log: Assertions.om,v $ + Revision 1.2 1996/01/04 16:50:59 borchert + some fixes because event types are now an extension of Services.Object + + Revision 1.1 1994/02/22 20:06:01 borchert + Initial revision + + ---------------------------------------------------------------------------- + AFB 11/91 + ---------------------------------------------------------------------------- +*) + +MODULE ulmAssertions; + + (* general error handling of library routines *) + + IMPORT Disciplines := ulmDisciplines, Events := ulmEvents, IO := ulmIO, Priorities := ulmPriorities, RelatedEvents := ulmRelatedEvents, Services := ulmServices; + + TYPE + Object = Disciplines.Object; + Identifier* = ARRAY 32 OF CHAR; (* should be sufficient *) + Event* = POINTER TO EventRec; + EventRec* = + RECORD + (Events.EventRec) + object*: Object; (* may be NIL *) + module*: Identifier; + proc*: Identifier; + END; + EventType = POINTER TO EventTypeRec; + EventTypeRec* = + RECORD + (Events.EventTypeRec) + (* private components *) + module: Identifier; + END; + + VAR + failedAssertion*: Events.EventType; + eventTypeType: Services.Type; + + PROCEDURE Define*(VAR type: Events.EventType; module: ARRAY OF CHAR); + (* create a new event type which will be of type Assertions.EventType *) + VAR + newtype: EventType; + BEGIN + NEW(newtype); + Services.Init(newtype, eventTypeType); + Events.Init(newtype); + Events.SetPriority(newtype, Priorities.assertions); + COPY(module, newtype.module); + type := newtype; + END Define; + + PROCEDURE Raise*(object: RelatedEvents.Object; + type: Events.EventType; + proc: ARRAY OF CHAR; + text: ARRAY OF CHAR); + (* raise Assertions.failedAssertion; + create a event of the given type and pass it + to RelatedEvents.Raise (if object # NIL) + or Events.Raise (if object = NIL); + *) + VAR + event: Event; + + PROCEDURE CreateEvent(VAR event: Event; etype: Events.EventType); + BEGIN + NEW(event); + event.type := etype; + COPY(text, event.message); + event.object := object; + IF type IS EventType THEN + COPY(type(EventType).module, event.module); + ELSE + event.module[0] := 0X; + END; + COPY(proc, event.proc); + END CreateEvent; + + BEGIN + IO.WriteString("assertion failed: "); + IO.WriteString(text); IO.WriteString(" in procedure "); + IO.WriteString(proc); IO.WriteLn; + CreateEvent(event, failedAssertion); Events.Raise(event); + CreateEvent(event, type); + IF object = NIL THEN + Events.Raise(event); + ELSE + RelatedEvents.Raise(object, event); + END; + END Raise; + +BEGIN + Events.Define(failedAssertion); + Events.SetPriority(failedAssertion, Priorities.assertions); + Events.Ignore(failedAssertion); + Services.CreateType(eventTypeType, + "Assertions.EventType", "Events.EventType"); +END ulmAssertions. diff --git a/src/lib/ulm/ulmIndirectDisciplines.Mod b/src/lib/ulm/ulmIndirectDisciplines.Mod new file mode 100644 index 00000000..bdce8212 --- /dev/null +++ b/src/lib/ulm/ulmIndirectDisciplines.Mod @@ -0,0 +1,122 @@ +(* Ulm's Oberon Library + Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany + ---------------------------------------------------------------------------- + Ulm's Oberon Library is free software; you can redistribute it + and/or modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either version + 2 of the License, or (at your option) any later version. + + Ulm's Oberon Library 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 GNU + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + ---------------------------------------------------------------------------- + E-mail contact: oberon@mathematik.uni-ulm.de + ---------------------------------------------------------------------------- + $Id: IndirectDis.om,v 1.2 1995/03/17 13:56:51 borchert Exp $ + ---------------------------------------------------------------------------- + $Log: IndirectDis.om,v $ + Revision 1.2 1995/03/17 13:56:51 borchert + support of Forwarders added + + Revision 1.1 1994/06/27 09:50:43 borchert + Initial revision + + ---------------------------------------------------------------------------- +*) + +MODULE ulmIndirectDisciplines; + + IMPORT Disciplines := ulmDisciplines, Forwarders := ulmForwarders; + + TYPE + Object* = Disciplines.Object; + ObjectRec* = Disciplines.ObjectRec; + Discipline* = Disciplines.Discipline; + DisciplineRec* = Disciplines.DisciplineRec; + Identifier* = Disciplines.Identifier; + + TYPE + IndDiscipline = POINTER TO IndDisciplineRec; + IndDisciplineRec = + RECORD + (DisciplineRec) + forwardTo: Object; + END; + VAR + discID: Identifier; + + PROCEDURE Forward*(from, to: Object); + VAR + disc: IndDiscipline; + BEGIN + IF to = NIL THEN + Disciplines.Remove(from, discID); + ELSE + NEW(disc); disc.id := discID; + disc.forwardTo := to; + Disciplines.Add(from, disc); + END; + END Forward; + + PROCEDURE InternalForward(from, to: Forwarders.Object); + BEGIN + Forward(from, to); + END InternalForward; + + PROCEDURE Add*(object: Object; discipline: Discipline); + VAR + disc: IndDiscipline; + BEGIN + WHILE Disciplines.Seek(object, discID, disc) DO + object := disc.forwardTo; + END; + Disciplines.Add(object, discipline); + END Add; + + PROCEDURE Remove*(object: Object; id: Identifier); + VAR + dummy: Discipline; + disc: IndDiscipline; + BEGIN + LOOP + IF Disciplines.Seek(object, id, dummy) THEN + Disciplines.Remove(object, id); + EXIT + END; + IF ~Disciplines.Seek(object, discID, disc) THEN + EXIT + END; + object := disc.forwardTo; + END; + END Remove; + + PROCEDURE Seek*(object: Object; id: Identifier; + VAR discipline: Discipline) : BOOLEAN; + VAR + disc: IndDiscipline; + BEGIN + LOOP + IF Disciplines.Seek(object, id, discipline) THEN + RETURN TRUE + END; + IF ~Disciplines.Seek(object, discID, disc) THEN + RETURN FALSE + END; + object := disc.forwardTo; + END; + END Seek; + + PROCEDURE Unique*() : Identifier; + BEGIN + RETURN Disciplines.Unique() + END Unique; + +BEGIN + discID := Disciplines.Unique(); + Forwarders.Register("", InternalForward); +END ulmIndirectDisciplines.