OberonCore

MODULE a1
TYPE
 tpRecord = POINTER TO RECORD
    a:BYTE
  END;

PROCEDURE Init*(tpr_:tpRecord; a_:BYTE);
BEGIN
  NEW(tpr_);
  tpr_.a:=a_
END Init;

END a1.

MODULE a2;
IMPORT a1;
VAR
    myVar: a1.tpRecord;

BEGIN
  a1.Init(myVar,0)
END a1.

   TYPE
      tpGrad* = POINTER TO EXTENSIBLE RECORD (mTf.tpFaze)
      END;

PROCEDURE Init(VAR grad_:tpGrad; faze_:BYTE);
BEGIN
  NEW(grad_);
  mTf.Init(grad_.????) (* вот здесь как быть -- не догоняю *)
END Init;

MODULE MyTest;
   IMPORT  Log;
   
   TYPE
      Animal = POINTER TO ABSTRACT RECORD
         next: Animal
      END;
      Cat = POINTER TO RECORD (Animal) END;
      Dog = POINTER TO RECORD (Animal) END;
      Directory = POINTER TO RECORD
         root: Animal
      END;

   VAR
      dir: Directory;

   PROCEDURE (d: Directory) Add (a: Animal), NEW;
   VAR tmp: Animal;
   BEGIN
      IF d.root = NIL THEN
         d.root := a
      ELSE
         tmp := d.root;
         WHILE tmp.next # NIL DO tmp := tmp.next END;
         tmp.next := a
      END
   END Add;
   
   PROCEDURE (a: Animal) FeedMilk, NEW, ABSTRACT;
   
   PROCEDURE (a: Cat) FeedMilk;
   BEGIN
      Log.String("Mmm!"); Log.Ln;
   END FeedMilk;
   
   PROCEDURE (a: Dog) FeedMilk;
   BEGIN
      Log.String("No thanks!"); Log.Ln;
   END FeedMilk;
   
   (* Фабрика объетов *)
   PROCEDURE (d: Directory) New (type: INTEGER): Animal, NEW;
   VAR a: Animal; cat: Cat; dog: Dog;
   BEGIN
      CASE type OF 1:
         NEW(cat);
         a := cat;
      | 2 :
         NEW(dog);
         a := dog;
      ELSE END;
      dir.Add(a);
      
      RETURN a
   END New;
   
   PROCEDURE Test*;
      VAR a: Animal;
   BEGIN
      dir.root := NIL;
      (* add animals *)
      a := dir.New(1);
      a := dir.New(2);
      
      a := dir.root;
      WHILE a # NIL DO
         a.FeedMilk;
         a := a.next
      END
   END Test;

BEGIN
   NEW(dir);
   
END MyTest.

MyTest.Test

      (* Load realisations for current platform *)
      IF Dialog.IsWindows() THEN
         ASSERT(Kernel.ThisMod('Sdl2StdWin') # NIL, 20)
      ELSIF Dialog.IsLinux() THEN
         ASSERT(Kernel.ThisMod('Sdl2StdLin') # NIL, 20)
      ELSE HALT(20) END;

PROCEDURE Модуль_выгрузить(IN мод_: ARRAY OF CHAR);
   VAR
      модуль: мЯдро.Module;
   BEGIN
      модуль:=мЯдро.ThisMod(мод_);
      мЯдро.UnloadMod(модуль)
   END Модуль_выгрузить;