Seite 1 von 3

Module oop und EnableClass

Verfasst: 06.09.2015 10:10
von GPI
Mit Interfaces unterstützt PureBasic eine minimalste Version von oop. Leider ist das ganze nicht so einfach, man muss vTables pflegen. Wenn es um Themen wie Vererbung, Destruktoren, Kopierkonstruktor und ähnlichen geht, wird es aber sehr schnell umständlich.
Meine Zielsetzung hier war:
  • einfache Klassen-Erstellung (inklusive vTables)
  • Vererbung (inklusive überschreiben von Methoden der Parents
  • Pointer auf Objekte
  • Modulunterstützung (Sowohl Objekte und Klassen können Privat und Öffentlich sein
  • Konstruktor
  • Destruktor
  • Kopierkonstruktor
  • Speicherverwaltung möglichst durch PureBasic und nicht mittels AllocateMemory()
  • Fehlersuche unterstützen
Herausgekommen ist dabei der Code in nächsten Post.

Definition einer Klasse
Eigentlich sehr einfach, zum Beispiel so

Code: Alles auswählen

Class(cName)
  ParentClass(cParent) ;optional
  DeclareMethods
    <Liste der Methoden, wie man sie in Interface angibt>
  Properties
    <Membervariablen, wie man sie in einer Struktur angibt>
  Methods
    <Definitionen der Methoden>
EndClass
Die Reihenfolge ist wichtig, man darf sie nicht mischen. Genauso darf man die Class() und ParentClass() Anweisung nicht durch einen Doppelpunkt auf eine Zeile ziehen. Die Macros würden sonst nicht mehr funktionieren.
Auch darf man nichts weglassen. z.b. wenn keine Membervariablen benötigt werden, muss man trotzdem die Properties-Zeile schreiben.

Die Properties sind immer Privat. Leider ist es nicht so einfach, die öffentlich zu machen. Das seh ich aber nicht als so großen Beinbruch, da man die eh am besten per Methoden abfragen kann. Statische Properties sind leider auch nicht möglich. Hier muss man auf Globale Variablen zurück greifen.

die Definitionen der Methoden ist prinzipiell wie Proceduren aufgebaut, hier ein Beispiel:

Code: Alles auswählen

Method(i,Set,Var.x)
  *self\Value=Var
  self\CheckValue()
  MethodeReturn *self\Value
EndMethod
Method (Rückgabetyp, Methodenname [, Variablenliste])
Leider ist ein "Method.i name(" nicht möglich. Der Rückgabetyp muss hier als erster Parameter angeben werden. Die Variablenliste kann aktuell bis zu 10 Parameter lang sein (kann aber erweitert werden. Dazu muss man sich nur das Method-Macro anschauen).
Die Methoden müssen von Rückgabetyp und der Variablenliste mit denen in der Deklaration überein stimmen. Leider ist es nicht möglich zu überprüfen, ob das wirklich so ist.

self
Mit *self\ kann man auf die Properties zugreifen, lesen und schreiben. Mit self\ kann man andere Methoden der Klasse aufrufen.

Das wars schon. Anschließend kann man die Klasse benutzen.
Das einzige was man beachten muss: Die Klassendefinition enthält ausführbaren Code (im Hintergrund wird bspw. eine vTable gefüllt). Deshalb darf man eine Klasse nicht in einer Procedure oder innerhalb If-Endif oder ähnlichen definieren. Ansonsten ist ein Absturz ziemlich sicher.

Spezielle Methoden Initalize, Dispose, Clone
Initalize()
Das ist der Konstruktor. Er wird aufgerufen, sobald ein Objekt erstellt wird. Wenn eine Klasse einen Parent hat, werden alle Initalize()-Methoden sämtlicher Parents ausgeführt. Die Reihenfolge ist dabei fest, erst wird das Parent Initalize() dann das Child.
Ein Initalize muss sich also nur um die Properties kümmern, die neu in dieser Klasse dazugekommen sind.

Dispose()
Der Destruktor, er wird aufgerufen, sobald ein Objekt zerstört werden soll. Genauso wie Initalize werden alle Dispose()-Routinen von Parent und Child aufgerufen. Die Reihenfolge ist hier aber umgekehrt. Erst wird das Child Dispose() dann das Parent.
Nützlich bspw. um Handles freizugeben, die in der Methode geöffnet wurden. Aber auch um mittels Debug Fehler auszugeben, weil man bspw. mit einer Methode eine Datei geöffnet hat, aber später nicht mehr geschlossen hat.

Clone()
Wenn eine Kopie von einen Objekt erstellt wird, erzeugt mein Code eine wirkliche 1:1-Kopie. Das Problem ist, wenn in den Properties bspw. ein Pointer zu einen mit AllocateMemory() angeforderter Speicher vorhanden ist, dann zeigen sowohl Original als auch Kopie auf den exakt den gleichen Speicher. Wenn jetzt das Original den Speicher frei gibt, dann bekommt die Kopie davon nichts mit. Und sobald die Kopie das gleiche versucht crash das Programm.
Die Clone-Methode ist dazu da dieses Problem zu lösen. Und ja, man erhält keinen Parameter mit den Original-Objekt wie bspw in C++.
Das Objekt wurde schon vollständig kopiert (Arrays, Lists und Maps werden dabei korrekt gehandhabt). Man muss nur noch so Sachen wie Pointer, Handles etc. beachten.
Beispiel: In den Properties gibts *buffer und bufferlen, der Clone würde so aussehen:

Code: Alles auswählen

Method(i,Clone)
  define *save=*self\buffer
  if *self\buffer
    *self\buffer=AllocateMemory(*self\bufferlen)
    if *self\buffer=0
      MethodReturn #false
    endif
    CopyMemory(*save,*self\buffer,*self\bufferlen)
  endif
  MethodReturn #true
EndMethod
Das MethodReturn ist wichtig, wenn alles geklappt hat, muss man #true zurückgeben, ansonsten wird das kopierte Objekt sofort zerstört.
WICHTIG: Wenn das Clonen fehlschlägt, wird als nächstes Dispose aufgerufen! Man sollte also alle kritischen Properties so setzen, das sie kein Problem machen und das Original-Objekt nicht zerstören können.
Z.b.: Obriges Beispiel, nur das es zwei Speicherbereiche gibt. Die Speicheranforderung schlägt beim ersten fehl, dann muss vor MethodReturn unbedingt der Pointer auf den zweiten Speicherbereich auf Null gesetzt werden (der verweist ja noch auf das Original).

Code: Alles auswählen

Method(i,Clone)
  define *save=*self\buffer
  if *self\buffer
    *self\buffer=AllocateMemory(*self\bufferlen)
    if *self\buffer=0
      *self\buffer2=0 ; der verweist noch auf das Original!
      MethodReturn #false
    endif
    CopyMemory(*save,*self\buffer,*self\bufferlen)
  endif
  if *self\buffer2
    *save=*self\buffer2
    *self\buffer2=AllocateMemory(*self\bufferlen2)
    if *self\buffer2=0
      MethodReturn #false
    endif
    CopyMemory(*save,*self\buffer2,*self\bufferlen2)
  endif
  MethodReturn #true
EndMethod
Genauso wie Initalize wird bei Clone erst das Parent Clone() dann das Child Clone() ausgeführt.

PureBasic hasst Dispose
Mit PureBasic gibt es leider ein Problem. Wann ein Objekt Initalize aufrufen soll, ist einfach, aber es gibt keine automatische Möglichkeit ein Dispose aufzurufen.
Ein lokales Objekt ist bis zum "End" gültig, oder in einer Procedure bis EndProcedure oder ProcedureReturn.
Aus diesen Grund muss man diese Steuerworte durch _End , _EndProcedure und _ProcedureReturn ersetzen, sobald man Objekte benutzt. Ein Fehlendes _EndProcedure erkennen die Macros normalerweise selbstständig und verhindern ein Compilen. Ein fehlendes _End merkt man daran, das in Debug-Fenster ein "[INFO] _end" nicht erscheint. Leider gibt es keine Möglichkeit, ein fehlendes _ProcedureReturn festzustellen.
Aber wenn der Debugger läuft, erhöht jedes lokal erstellte Objekt einen Zähler und wenn ein Objekt korrekt mit Dispose zerstört wird, verringert sich der Zähler. Wenn dieser Zähler bei _End nicht Null ist, wird eine entsprechende Meldung ausgegeben!
"[WARNING] not disposed objects: ". Also es ist möglich festzustellen ob ein Fehler passiert ist.

Wie Schlimm ist ein fehlendes _ProcedureReturn?
Schwer zu sagen. Lokale Objekte werden vollständig in lokalen Variablen gespeichert. Diese gibt dann PureBasic frei. Sämtliche Handles, Speicher und ähnliches, die durch das Objekt angefordert wurden und normalerweise durch Dispose wieder freigegeben werden könnten, bleiben bis zum Programmende offen.

_End
_End funktioniert leider nicht in Proceduren! Allerdings sollte man End eh nicht in Proceduren aufrufen, außer man stellt fest, das ein gröberer Fehler passiert ist und man lieber den Stecker ziehen sollte.

_FakeEnd
Verhält sich genau wie _End nur dass das Programm nicht beendet wird. Allerdings sind sämtliche Objekte, also auch statische und globale, zerstört und eine Verwendung führt zu einem Absturz. _FakeEnd ist mehr für Debug-Zwecke gedacht.

Objekt-Vollüberwachung aktivieren
Wenn man vor den Include der Module_oop.pbi folgende Konstante setzt:

Code: Alles auswählen

#__class_debug_all_objects=#True
XIncludeFile("Module_oop.pbi")
Wird eine vollständige Überwachung sämtlicher Objekte aktiviert. Das _End-Macro listet dann sämtliche Objekte auf, die nicht korrekt mittels Dispose zerstört werden konnten, inklusive der Zeile, wo sie erstellt wurden. Also bspw.: "[WARNING] Missing dispose:clock.cClock E:\purebasic\OOP\main.pb@239".
So kann man fehlende _ProcedureReturns rausfinden. Nachteil ist, das die Objekt-Erstellung und Zerstörung langsamer wird und Speicher für die Protokollierung drauf geht.
Die Routinen sind nur aktiv, wenn ein Debugger an ist (wie sollte sonst auch die Ausgabe erfolgen?).

Objekte erstellen
Define_Object(<object name>,<class name>)
Protected_Object(<object name>,<class name>)
Global_Object(<object name>,<class name>)
Static_Object(<object name>,<class name>)

Einfach eines dieser Makros aufrufen und das Objekt wird definiert und initialisiert. Eins ist nur wichtig, dahinter befindet sich immer Code. Sowas

Code: Alles auswählen

If #False
  Define_Object(MyObj,cMyClass)
EndIf
würde das Objekt zwar deklarieren, aber nicht Initialisieren, weil der Code zwischen If-EndIf nie ausgeführt wird. Sobald man auf das Objekt zugreift, kommt es unweigerlich zum Absturz.
Die Objekte werden übrigens vollständig in lokalen/globale/statischen Variablen erstellt. Zerstört werden sie automatisch bei _EndProcedure, _ProcedureReturn und _End.

Pointer
Erzeugt man wie jeden anderen Pointer auch.

Code: Alles auswählen

*<pointer name>.<class name>
Zuweisungen
ACHTUNG, aufgrund wie PureBasic Interface handhabt, sollte man das hier beachten

Code: Alles auswählen

Define_Object(obj1,cMyClass)
Define_Object(obj2,cMyClass)
Define *pObj.cMyClass
obj1=obj2 ;Bad
*pObj=@obj1 ; Won't work
*pObj=obj1 ; Work
Bei obj1=obj2 wird keine Kopie erstellt, sondern obj1 verweist dann direkt auf obj2. Wie man ein Objekt auf das andere Cloned, erklär ich später.
*pObj1=@obj1 funktioniert auch nicht. Grund ist, das obj1 für PureBasic prinzipiell ein Pointer ist und man so die Adresse kriegt, die Adresse von Object enthält, also einen doppelten Pointer.

Allocate_Object(<class name>)
Free_Object(<object>)

Mittels diesen Funktionen kann man auch Objekte erzeugen. Diese werden aber mit "AllocateStructure" erzeugt und bleiben auch bestehen, wenn bspw. eine Procedure endet. Man muss sie manuell mit Free_Object() wieder freigeben. Das ist die einzige Möglichkeit, wie man bspw. Objekte in einer List, Map oder innerhalb einer Struktur unterbringen kann. Einfach einen Pointer dort erzeugen und mit Allocate_Object ein Objekt zuweisen.
Wichtig: _End kann diese Objekte nicht freigeben! Es gibt nur aus, ob solche Objekte nicht korrekt freigegeben wurden ("[WARNING] not disposed allocated objects: ").

Vererbung und Methoden überschreiben
Ein Beispiel sagt mehr als tausend Worte:

Code: Alles auswählen

Class(cVar)
  DeclareMethods
    Set(x)
    Get()
  Properties
    value.i
  Methods
    Method(i,Set,x.i)
      *self\value=x
    EndMethod
    Method(i,Get)
      MethodReturn *self\value
    EndMethod
EndClass

Class(cVar2)
  ParentClass(cVar)
  DeclareMethods
    OldSet(x)
  Properties
  Methods
    AliasMethod(Set,OldSet)
    Method(i,Set,x)
      *self\value=x*2
    EndMethod
EndClass

Define_Object(obj1,cVar2)
Define *obj2.cVar

obj1\Set(20) 
Debug obj1\Get(); Return 40
obj1\OldSet(20)
Debug obj1\Get(); Return 20

*obj2=obj1
*obj2\Set(30)
Debug obj2\Get(30); Return 60!
Die Klasse cVar2 wird aus der Klasse cVar abgeleitet. In cVar2 wird die Methode Set überschrieben. Da sie schon in cVar deklariert wurde, darf sie nicht mehr in cVar2 deklariert werden.
Mittels AliasMethod wird die ursprüngliche Set-Methode von cVar gerettet. Das muss vor den überschreiben der Methode passieren. Anschließend kann man die ursprüngliche Set()-Methode mit OldSet() aufrufen. Der Alias muss vorher in DeclareMethods deklariert werden.
Wichtig hier ist, das sich die Anzahl der Parameter nicht ändern darf. Es wird zwar keine Überprüfung durchgeführt (weil nicht möglich), aber der Versuch wird vermutlich die lustigsten Effekte verursachen und man wird ewig nach den Fehler suchen.
Vielleicht wird es einige Überraschen, warum der Pointer, der eigentlich von Typ cVar ist, bei Set die überschriebene Version von cVar2 aufruft. Grund ist, dass das Objekt selbst bestimmt, welche Funktionen aufgerufen werden und das Objekt ist von Typ cVar2.
Es ist völlig ungefährlich, ein Child (hier Typ cVar2) einen Parent (cVar) zuzuweisen, weil in Child alle Methoden und Properties von Parent vorhanden sind.

Eine sichere Weise, ein Objekt zuzuweisen
PureBasic unterstützt leider überhaupt keine Typen-Überprüfung. Es ist also durchaus möglich, das man einen Pointer ein Objekt zuweist, das überhaupt nicht zum Pointer passt. Das Ergebnis dürfte mehr als undefiniert sein, weil irgendwelche Methoden mit unsinnigen Parametern von Objekt aufgerufen wird, wenn man nach so einer Fehlzuweisung versucht darauf zuzugreifen.
Darum gibt es Funktionen, eine Klasse zu verifizieren:

Code: Alles auswählen

*obj2=Object_CheckClass(obj1,cVar)
Object_CheckClass überprüft, ob das Objekt (hier obj1) zur Klasse (hier cVar) gehört oder ob das Objekt ein Child von der Klasse ist. Wenn ja, wird das Objekt selbst zurückgegeben, ansonsten wird #Null.
Wenn also eine Zuweisung "fehlschlägt" erhält man ein Null-Objekt und wenn man darauf zugreift, stürzt das Programm immer "sauber" ab. Und das ist bedeutend besser, als wenn das Programm willkürlich irgendwelche Methoden aufruft.

Für Proceduren, die drauf angewiesen sind, einen Pointer von einen Objekt zu erhalten, können diesen auch mit folgender Funktion überprüfen:
Object_ForceClass(<object>,<class name>)
Wenn das Objekt zur Klasse nicht passt, wird in Debugger eine Fehlermeldung ausgegeben und das Programm wird angehalten. Ohne Debugger wird das ganze sogar sofort beendet. Die Idee dahinter ist, das irgendwas komplett schief gelaufen ist und ein weiteres Ausführen des Programms nur in eine größere Katastrophe führt.

Spezielle Klasse oop::object
oop::object ist quasi die Root-Klasse. Aus dieser werden sämtliche andere Klassen abgeleitet. Ein Pointer diesen Typs kann also sämtliche Objekte gefahrlos handhaben.

Diese Klasse enthält auch einige Basis-Methoden, die alle Klassen beherrschen.
Methode GetClassName()
Gibt die Klasse des Objekt als String zurück (nicht die Klasse des Pointers!).

Methode Size()
Gibt den Speicherverbrauch des Objekts zurück. Leider etwas unvollständig, wenn Arrays, Listen, Maps in den Properties vorhanden sind, werden die nicht berücksichtigt. Genauso wenn man selbst Speicher anfordert und in einen Pointer speichert.

Methode CloneFrom(<source-object>)
Zerstört das Objekt und erstellt anschließend eine Kopie von Source-Objekt.
Hier ein Beispiel:

Code: Alles auswählen

  Protected_Object(obj1,cVar)
  Protected_Object(obj2,cVar)
  obj2\Set(30)
  obj1\CloneFrom(obj2)
Im Beispiel wird das ursprüngliche obj1 vernichtet und anschließend eine Kopie von Obj2 erzeugt und obj1 zugewiesen.
Sollte das Clonen fehlschlagen, gibt CloneFrom() #False zurück, ansonsten #True.

Methode AllocateClone()
Erstellt einen Clone von Objekt und gibt ihn zurück. Dieser Clone muss manuell mit Free_Object() wieder freigegeben werden. Sollte das Objekt nicht geclont werden können, wird #Null zurückgegeben.

Reset()
Zerstört das Objekt und initialisiert es neu.

Anwendungsmöglichkeiten
Mit der Basisklasse oop::object kann man Objekte Clonen, den Typ abfragen und den Klassennamen herausbekommen, ohne dass man weis, was für ein Objekt man hier hat.
Man kann bspw. eine Procedure schreiben, die verschiedene Objekte entgegennehmen kann und anschließend verzweigt. z.b.

Code: Alles auswählen

;Class cText is used for storing long text.
;Class cPicture is used for storing pictures.
Procedure Print_Objekt(*obj.oop::object)
  Define *text.cText
  Define *pic.cPicture

  If Object_Class(*obj,cText)
    *text=*obj
    <print *text>
  ElseIf Object_Class(*obj,cPicture)
    *pic=*obj
    <print *picture>
  EndIf
EndProcedure
Module
Wie versprochen, meine Routinen können in Modulen verwendet werden. Dazu muss aber mittels

Code: Alles auswählen

UseModule EnableClass
im Modul aktiviert werden. Am besten schreibt man diese Zeile als erstes in DeclareModule.

Lokale und öffentliche Objekte
Hier ändert sich eigentlich überhaupt nichts. Einfach wie bisher mit bspw. Define_Object() das Objekt entweder in DeclareModule-EndDeclareModule oder Modul-EndModule - Abschnitt definieren. Wie man es bisher auch mit Variablen gemacht hat.

Lokale Klassen
Auch das hier ist einfach, einfach die Klasse in Module-EndModule unterbringen und sie kann anschließend in Modul benutzt werden.

Öffentliche Klassen
Hier wird es etwas komplizierter. Man muss die Klasse dann in DeclareModule-EndDeclareModule deklarieren und anschließend in Module-EndModule definieren.
Dafür gibt es die neuen Steuerwörter DeclareClass-EndDeclareClass und enthält die Steuerwörter "ParentClass"(falls vorhanden) "Declare Methods" und "Properties". DefineClass-EndDefineClass enthält dann nur noch die Methoden.
Ein Beispiel sagt mehr als tausend Worte:

Code: Alles auswählen

DeclareModule TestModul1

  UseModule EnableClass
  
  DeclareClass(cTM1)
    DeclareMethods
      Get()
      Set(v.i)
    Properties
      value.i
  EndDeclareClass

EndDeclareModule

Module TestModul1

  DefineClass(cTM1)
    Method(i,Get)
      MethodReturn *self\value
    EndMethod
    Method(i,Set,v.i)
      *self\value=v
    EndMethod
  EndDefineClass

EndModule
Wichtig: Bevor man ein Objekt erzeugen kann, muss unbedingt die Klasse definiert werden! Die Deklaration funktioniert also nicht wie bei Proceduren, wo man sie bereits einsetzen kann, sobald man diese mal deklariert hat.

Objekte in Klassen
Sind jetzt auch möglich. Leider ist es nicht ganz so einfach. Man muss in den Properties das Objekt definieren und in der Methode Initalize initialisieren. Um Clone und Dispose muss man sich nicht kümmern, das macht mein Code automatisch

Declare_Object(<object-name>,<class>[,<arraysize>)
Kann nur in Properties-Bereich benutzt werden. Arraysize ist optional. Zukünftig kann man dann mit bspw. *self\<objectname>[1] darauf zurückgreifen.

Initalize_Object(<object-name>,<class>[,<arraysize>)
Muss innerhalb der Initalize-Methode benutzt werden. Die Angaben müssen mit Declare übereinstimmen.

Hier ein Beispiel:

Code: Alles auswählen

 Class(cDeep2);- cDeep2
    DeclareMethods
    Properties
      Declare_Object(var,cDeep1,2)
    Methods
      Method(i,Initalize)
        Initalize_Object(var,cDeep1,2)      
        *self\fakemem=fakealloc()
      EndMethod
  EndClass
Sonstige Funktionen/Macros
SizeOf_Class(<class name>)
Gibt die Größe eines Objekt der Klasse zurück.

DebugCreate_Obj(<obj name>,<message>)
Gibt eine Message in Debug aus und wann und wo das Objekt erstellt wurde. Die Funktion verhält sich wie der Debug-Befehl.
Kann bspw. praktisch sein, wenn man in Dispose() feststellt, das Handles nicht korrekt geschlossen wurden.

Internes
Da ich die Speicherverwaltung möglichst ohne AllocateMemory durchführen wollte, erzeugen die Macros einige zusätzlich Variablen,Labels,Strukturen. Normalerweise braucht man sich nicht darum kümmern.

Was wird alles bei der Klassen-Definition
Wenn eine Klasse "MyClass" erstellt wird, passiert in Hintergrund folgendes:
Class sichert den Klassenname in der DataSection und markiert die Stelle mit einem Label "MyClass__Class__Name" versehen.
DeclareMethods ist eigentlich eine Interface-Erstellung mit "MyClass" als Interface-Namen.
Properties erzeugt eine Struktur "MyClass__Class__struc", in der sämtliche Properties und auch einige interne Variablen wie der Pointer zur vTable gespeichert werden.
Methods erzeugt eine Struktur "MyClass__Class__VTable" und eine globale Variable "MyClass__Class__functions.MyClass__Class__VTable". Sämtliche Objekte dieser Klasse benutzen genau diese eine vTable.
Method-EndMethode ist eigentlich ein Procedure-EndProcedure-Aufruf. Die Procedure wird allerdings in "MyClass__Class__<Methoden-name>" umbenannt. Am Ende wird die so erstellte Procedure in der VTable mittels PokeI() eingetragen.
EndClass erstellt noch zwei Proceduren ("MyClass__Class____CopyStructure" und "MyClass__Class____AllocateStructure") und trägt sie in die vTable ein. Die beiden Routinen werden intern für Clone benötigt.

Was wird alles bei der Objekt-Definition
Define_Object()
Define_Object(MyObj,MyClass) macht folgendes:
Falls noch nicht passiert, wird eine lokale Variable "*__Class__define_dispose_chain" erstellt. Diese Variable enthält immer das zuletzt erstellte Objekt und wird für Dispose benötigt.
Als erstes wird das eigentliche Objekt mit "Define MyObj__Class__obj.MyClass__Class__struc" erstellt und die Variable "Define MyObj.MyClass" und das Objekt initalisiert.
Protect_Object(), Static_Object() und Global_Object verlaufen analog dazu.
Allocate_Object()
Erzeugt keinerlei zusätliche Sachen.

Was ist die Dispose-Chain?
Um lokale Objekte frei zu geben, müssen sie irgendwo eingetragen werden. Ich nutzte dazu die oben genannte Variable. Wenn ein neues Objekt erstellt wird, wird der Wert der Variable in Objekt gespeichert und anschließend wird die *__Class__define_dispose_chain auf das neue Objekt gesetzt. Auf diese Weise kann ich bei einen _EndProcedure oder _ProcedureReturn die Kette wieder aufzwirbeln und jedes Objekt auflösen. Die Clone-Funktionen sind so geschrieben, das sie die Kette nicht zerstören.
Globale Objekte (und statische) bauen eine eigene Dispose-Chain auf und werden bei "_End" freigeben.
AllocateObjekt() werden in diesen Chains nicht erfasst!

Warum zwei Module?
Das Modul EnableClass muss ja alle mittels "UseModul" überall freigegeben werden, sonst funktionieren die ganzen Makros nicht mehr. Ich brauch aber eine Möglichkeit, verschiedene Variablen, Macros und Proceduren unterzubringen, die von überall aufgerufen werden sollen. Darum das Modul oop.

Editoreinstellungen
Ich empfehle unter Costum-Keywords folgende Wörter hinzuzufügen:

Code: Alles auswählen

Class
DeclareClass
DefineClass
ParentClass
DeclareMethods
Properties
Methods
EndDeclareClass
Method
MethodReturn
EndMethod
AliasMethod
EndClass
EndDefineClass
Allocate_Object
Free_Object
Protected_Object
Global_Object
Define_Object
Static_Object
Declare_Object
Initalize_Object
_FakeEnd
_End
_EndProcedure
_ProcedureReturn
self
und unter Indentation

Code: Alles auswählen

_EndProcedure -1 0
Class 0 1
DeclareClass 0 1
DefineClass 0 1
DeclareMethods 0 1
EndClass -2 0
EndDeclareClass -2 0
EndDefineClass -1 0
EndMethod -1 0
Method 0 1
Methods -1 1
Properties -1 1
Dann sollte der Code schön sauber dargestellt werden.

Das Ende
Wie immer, über feedback würde ich mich freuen. Es ist schon erstaunlich, wieviel OOP eigentlich schon in PureBasic steckt und man nur aus Designgründen darauf verzichtet, damit die Sprache "sauber" bleibt. Es muss ja nicht gleich ein Machwerk wie bei C++ sein.

Re: Module oop und EnableClass

Verfasst: 06.09.2015 10:10
von GPI
Hier der versprochene Code:
Module_oop.pbi

Code: Alles auswählen

;*
;* Module oop and EnableClass
;*
;* Version: 1.1
;* Date: 2015-09-20
;*
;* Written by GPI
;*

;* Changelog
;* 1.1
;*    - some code improvments
;*    - ThreadSave - Mutex for global/static objects
;*    - Declare_Object and Initalize_Object for "Properties"
;*    - Self/CloneFrom() - reset object on fail
;*    - Self/Reset() - destroy und reinitalize object with default values

CompilerIf #PB_Compiler_IsMainFile
  #__Class_debug_all_objects=#True
CompilerEndIf



CompilerIf Not Defined(__Class_debug_all_objects,#PB_Constant)
  #__Class_debug_all_objects=#False
  ;when true, monitor all objects and output all object without dispose on "_end"
  ;for example: [WARNING] Missing dispose:clock.cClock E:\purebasic\OOP\main.pb@239
  ;only with debugger
CompilerEndIf

;- ***
;- *** module oop
;- ***


CompilerIf #__Class_debug_all_objects
  DeclareModule oop
    #debug_all_objects=#True
  CompilerElse
    DeclareModule oop 
      #debug_all_objects=#False
    CompilerEndIf
    
    
    
    EnableExplicit
    
    
    ;-
    ;-{ Macro Creation
    
    Macro MacroColon
      :
    EndMacro
    
    Macro MacroQuote
      "
    EndMacro
    
    Macro JoinMacroParts (P1, P2=, P3=, P4=, P5=, P6=, P7=, P8=)
      P1#P2#P3#P4#P5#P6#P7#P8
    EndMacro
    
    Macro CreateMacro (name,macroBody=)
      oop::JoinMacroParts (Macro name, oop::MacroColon, macroBody, oop::MacroColon, EndMacro)
    EndMacro
    
    Macro CreateQuote (name)
      oop::JoinMacroParts (oop::MacroQuote, name, oop::MacroQuote)
    EndMacro
    ;}
    ;-
    
    ;-
    ;-{ Basisclasse Object
    Declare AllocateClone (*self)
    Declare CloneFrom (*self,*source)
    Declare __Init (*self)
    Declare __Disp (*self)
    Declare.s GetClassName (*self)
    Declare __CheckClass (*self,*table)
    Declare Size (*self)
    Declare Reset(*self)
    
    CompilerIf #PB_Compiler_Debugger
      Declare __DebugOut (*self,message.s)
    CompilerEndIf
    
    DataSection     
      object__Class__Name:
      Data.s "object"
    EndDataSection
    
    Interface object
      AllocateClone()
      CloneFrom(*obj)
      __init()
      __disp()      
      GetClassName.s()
      __CheckClass(*table)
      Size()
      Reset()
      __Initalize()
      __Dispose()
      __Clone()
      __VTable_parent() ;var
      __CopyStructure(*new)
      __AllocateStructure()
      __ResetStructure()
      __classname();var
      __size()     ;var
      __deep()     ;var
      CompilerIf #PB_Compiler_Debugger
        __DebugOut(test.s)
      CompilerEndIf   
    EndInterface
    
    Structure object__Class__VTable
      *AllocateClone
      *CloneFrom
      *__init
      *__disp
      *GetClassName
      *__CheckClass
      *Size
      *Reset
      *__Initalize
      *__Dispose
      *__Clone
      *__VTable_parent.object__Class__VTable    
      *__CopyStructure
      *__AllocateStructure
      *__ResetStructure
      *__classname
      *__size
      *__deep
      CompilerIf #PB_Compiler_Debugger
        *__DebugOut
      CompilerEndIf   
    EndStructure
    
    Structure object__Class__struc 
      *__VTable.object__Class__VTable    
      *__dispose_chain
      *__properties_chain
      CompilerIf #PB_Compiler_Debugger
        __objname.s
        __creationline.l
        __creationfile.s
      CompilerEndIf
    EndStructure
    
    Global object__Class__functions.object__Class__VTable
    object__Class__functions\AllocateClone=@AllocateClone()
    object__Class__functions\CloneFrom=@CloneFrom()    
    object__Class__functions\__init=@__init()
    object__Class__functions\__disp=@__disp()
    object__Class__functions\GetClassName=@GetClassName()
    object__Class__functions\__CheckClass=@__CheckClass()
    object__Class__functions\Size=@Size()
    object__Class__functions\Reset=@Reset()
    object__Class__functions\__classname=?object__Class__Name
    object__Class__functions\__size=SizeOf(object__Class__struc )
    object__Class__functions\__deep=-1
    
    CompilerIf #PB_Compiler_Debugger
      object__Class__functions\__DebugOut=@__DebugOut() 
    CompilerEndIf  
    ;}
    ;-
    
    ;-
    ;-{ Debug
    CompilerIf #PB_Compiler_Debugger
      Global counter__object.i
      Global counter__allocate__object.i
    CompilerEndIf
    
    CompilerIf #debug_all_objects And #PB_Compiler_Debugger
      Declare addobj(*obj.object)
      Declare subobj(*obj.object)
      Declare listobj()
    CompilerElse
      Macro addobj(a)
      EndMacro
      Macro subobj(a)
      EndMacro
      Macro listobj()
      EndMacro
    CompilerEndIf
    ;}
    ;-
    
    ;-
    ;-{ Common
    Define Mutex_GlobalChain=CreateMutex()
    Global *__Class__global_dispose_chain
    Define *__Class__define_dispose_chain
    
    CompilerIf #PB_Compiler_Debugger
      Declare Obj_init(*objVTable, size, *obj.object,name$,line,file$ )
    CompilerElse
      Declare Obj_init(*objVTable, size, *obj.object)
    CompilerEndIf
    
    Macro newobj(access,obj,ClassName,lis)
      CompilerIf (Not Defined(*__Class__define_dispose_chain,#PB_Variable) Or #PB_Compiler_Procedure="") And oop::CreateQuote(__Class__endprocedurecheck()) = "fail"
        CompilerError "missing _EndProcedure or _ProcedureReturn above this line!"
      CompilerEndIf  
      
      CompilerIf oop::CreateQuote(lis)="Define" And #PB_Compiler_Procedure<>"" And Not Defined(*__Class__define_dispose_chain,#PB_Variable)
        Define *__Class__define_dispose_chain.oop::object__Class__struc
      CompilerEndIf
      
      access obj#__Class__obj.ClassName#__Class__struc
      access obj.ClassName
      
      If obj=0
        obj=obj#__Class__obj  
        obj#__Class__obj\__VTable=ClassName#__Class__functions
        CompilerIf #PB_Compiler_Debugger
          obj#__Class__obj\__objname=oop::CreateQuote(obj)
          obj#__Class__obj\__creationline=#PB_Compiler_Line
          obj#__Class__obj\__creationfile=#PB_Compiler_File
          oop::addobj(obj)
        CompilerEndIf    
        obj\__init()
        
        
        CompilerIf oop::CreateQuote(lis)="Global" Or #PB_Compiler_Procedure=""
          CompilerIf oop::CreateQuote(lis)="Global" And #PB_Compiler_Thread
            LockMutex(oop::Mutex_GlobalChain)
          CompilerEndIf
          obj#__Class__obj\__dispose_chain=oop::*__Class__#lis#_dispose_chain
          oop::*__Class__#lis#_dispose_chain=obj
          CompilerIf oop::CreateQuote(lis)="Global" And #PB_Compiler_Thread
            UnlockMutex(oop::Mutex_GlobalChain)
          CompilerEndIf
        CompilerElse      
          obj#__Class__obj\__dispose_chain=*__Class__#lis#_dispose_chain
          *__Class__#lis#_dispose_chain=obj
        CompilerEndIf
        
        CompilerIf #PB_Compiler_Debugger
          oop::counter__object+1
        CompilerEndIf
      EndIf 
      
      CompilerIf oop::CreateQuote(__Class__endprocedurecheck()) = "__Class__endprocedurecheck()" And #PB_Compiler_Procedure<>"":oop::CreateMacro(__Class__endprocedurecheck(),fail):  CompilerEndIf
    EndMacro
    
    Macro Dispose_local_obj()
      CompilerIf #PB_Compiler_Procedure<>""
        CompilerIf Defined(*__Class__define_dispose_chain,#PB_Variable)
          oop::dispose_chain(*__Class__define_dispose_chain)
          *__Class__define_dispose_chain=0
        CompilerEndIf
      CompilerElse
        oop::dispose_chain(oop::*__Class__define_dispose_chain)
        oop::*__Class__define_dispose_chain=0
      CompilerEndIf
      
    EndMacro
    
    Macro Dispose_global_obj()
      oop::dispose_chain(oop::*__Class__global_dispose_chain)
      oop::*__Class__global_dispose_chain=0
    EndMacro
    
    
    Declare dispose_chain(obj.object)
    ;}
    ;-
    
  EndDeclareModule
  
  Module oop
    
    ;-
    ;-{ common
    CompilerIf #PB_Compiler_Debugger
      Procedure Obj_init(*objVTable,size, *obj.oop::object,name$,line,file$ )  : ;EndIndent
                                                                                 ;}
    CompilerElse
      Procedure Obj_init(*objVTable,size, *obj.oop::object)
      CompilerEndIf
      Protected *obj_struc.object__Class__struc=*obj
      If *obj
        *obj_struc\__VTable=*objVTable
        CompilerIf #PB_Compiler_Debugger
          *obj_struc\__objname=name$
          *obj_struc\__creationline=line  
          *obj_struc\__creationfile=file$
          addobj(*obj)
          oop::counter__allocate__object+1
        CompilerEndIf    
        *obj\__init()
        
      EndIf
      ProcedureReturn *obj
    EndProcedure
    Procedure dispose_chain(obj.object)
      Define *obj.oop::object__Class__struc=obj
      Define *next
      While *obj
        obj=*obj
        *next=*obj\__dispose_chain
        *obj\__dispose_chain=0
        If *obj\__VTable
          obj\__Disp() 
          CompilerIf #PB_Compiler_Debugger
            oop::counter__object-1
            oop::subobj(obj)
          CompilerEndIf
        EndIf
        *obj=*next
      Wend
    EndProcedure
    ;}
    ;-
    
    ;-
    ;-{ object methods
    
    
    Procedure reset(*self.object__Class__struc)
      Define save.object__class__struc
      Define *VTable.object__Class__VTable=*self\__vtable
      
      CopyStructure(*self,save,object__Class__struc);backup base settings
      
      CallFunctionFast(*VTable\__disp,*self);destroy
      
      CallFunctionFast(*VTable\__ResetStructure,*self);reset values
      
      CopyStructure(save,*self,object__Class__struc);restore base settings
      
      CallFunctionFast(*vtable\__Init,*self);initalize
    EndProcedure
    
    Procedure CountObjects(*self.object__Class__struc)
      Define *obj.object__Class__struc
      Define count
      *obj=*self\__properties_chain
      While *obj
        If *obj\__properties_chain
          count+CountObjects(*obj)      
        EndIf      
        Count+1      
        *obj=*obj\__dispose_chain
      Wend  
      ProcedureReturn count
    EndProcedure
    
    Structure SavedObject
      *int.long
      *obj.object__Class__struc
      save.object__Class__struc
    EndStructure
    
    Procedure SaveObjects(*self.object__Class__struc,Array saveobj.Savedobject(1),i=0)
      Define *obj.object__Class__struc
      *obj=*self\__properties_chain
      While *obj
        saveobj(i)\int=*self+PeekL(*obj-SizeOf(long))
        saveobj(i)\obj=*obj
        
        CopyStructure(*obj,saveobj(i)\save,object__Class__struc)
        i+1      
        i=SaveObjects(*obj,SaveObj(),i)      
        
        *obj=*obj\__dispose_chain
      Wend  
      ProcedureReturn i
    EndProcedure
    
    Procedure CloneChain(*self.object__Class__struc)
      Define i
      Define ret=#True
      Define *VTable.object__Class__VTable
      
      *VTable=*self\__VTable    
      ;If *VTable\__deep
      Dim *saveClone(*VTable\__deep)
      
      While *VTable
        If *VTable\__Clone
          *saveClone(i)=*VTable\__Clone
          i+1
        EndIf
        *VTable=*VTable\__VTable_parent
      Wend  
      
      While i>0
        i-1
        ret & CallFunctionFast(*saveClone(i),*self)
      Wend
      ;EndIf
      ProcedureReturn ret
    EndProcedure
    
    
    Procedure RecoverObjects(*self.object__Class__struc,*new.object__Class__struc,Array *objlist.object__Class__struc(1),i=0)
      Define *obj.object__Class__struc
      Define *objnew.object__Class__struc
      Define i
      *obj=*self\__properties_chain
      *objnew=*new+(*obj-*self)
      *new\__properties_chain=*objnew
      Repeat      
        PokeI(*new+PeekL(*obj-SizeOf(long)),*objnew)
        *objlist(i)=*objnew        
        i+1
        
        If *obj\__properties_chain
          i=RecoverObjects(*obj,*objnew,*objlist(),i)
        EndIf
        
        
        *obj=*obj\__dispose_chain
        If *obj
          *objnew\__dispose_chain=*new+(*obj-*self)
          *objnew=*objnew\__dispose_chain        
        EndIf      
      Until *obj=0
      ProcedureReturn i
    EndProcedure        
    
    Procedure AllocateClone (*self.object__Class__struc)
      Define ret=#True
      Define *new.object__Class__struc
      Define count
      Define i
      Define *VTable.object__Class__VTable
      
      *VTable=*self\__VTable
      *new=CallFunctionFast(*VTable\__AllocateStructure,*self)
      If *new=0
        ProcedureReturn #False
      EndIf
      
      If *self\__properties_chain
        count=CountObjects(*self)
      EndIf
      
      CallFunctionFast(*VTable\__CopyStructure,*self,*new)
      *new\__dispose_chain=0
      *new\__properties_chain=0
      CompilerIf #PB_Compiler_Debugger
        *new\__objname="*clone:"+*self\__objname
        oop::addobj(*new)
        oop::counter__allocate__object+1
      CompilerEndIf   
      
      If count
        Dim *ObjList.object__Class__struc(count-1)
        RecoverObjects(*self,*new,*ObjList())
        For i=count-1 To 0 Step -1
          ret & CloneChain(*ObjList(i))
          CompilerIf #PB_Compiler_Debugger
            *ObjList(i)\__objname="*clone:"+*ObjList(i)\__objname
            oop::addobj(*ObjList(i))
            counter__object+1
          CompilerEndIf
        Next  
      EndIf
      
      
      ret & CloneChain(*new)
      
      If ret=#False
        CallFunctionFast(*vtable\__disp,*new)
        FreeStructure(*new)
        
        CompilerIf #PB_Compiler_Debugger
          oop::subobj(*new)
          oop::counter__allocate__object-1      
        CompilerEndIf      
        *new=0      
      EndIf    
      
      ProcedureReturn *new  
    EndProcedure
    
    Procedure CloneFrom (*self.object__Class__struc,*source.object__Class__struc)
      Define ret.i=#True
      Define save.object__Class__struc
      Define count
      Define i
      Define *VTable.object__Class__VTable
      
      If *self\__VTable<>*source\__VTable  Or *self=*source
        reset(*self)
        ProcedureReturn #False
      EndIf
      
      ;save before dispose because dispose kills the vtable
      If *self\__properties_chain
        count=CountObjects(*self)
        
        Dim SaveObj.SavedObject(count-1)
        SaveObjects(*self,SaveObj())
      EndIf
      
      
      ;Destroy the original object and copy from source
      *VTable=*self\__VTable
      CopyStructure(*self,save,object__Class__struc)
      CallFunctionFast(*VTable\__disp,*self)
      CallFunctionFast(*VTable\__CopyStructure,*source,*self) 
      CopyStructure(save,*self,object__Class__struc)
      
      If count
        CompilerIf #PB_Compiler_Debugger
          ;__disp will destroy the local objects, but we are recreate the objects from the copy
          counter__object+count
        CompilerEndIf
        For i=count-1 To 0 Step -1
          SaveObj(i)\int\l=SaveObj(i)\obj
          CopyStructure(SaveObj(i)\save,SaveObj(i)\obj,object__class__struc)
          ret & CloneChain(SaveObj(i)\obj)
        Next
      EndIf
      
      ret & CloneChain(*self)
      
      If ret=0
        reset(*self)
      EndIf    
      
      ProcedureReturn ret    
    EndProcedure
    
    Procedure __Init (*self.object__Class__struc)
      Define *VTable.object__Class__VTable
      Define i
      
      *VTable=*self\__VTable  
      
      ;If *vtable\__deep
      Dim *saveInitalize(*vtable\__deep)
      
      While *VTable
        If *VTable\__Initalize
          *saveInitalize(i)=*VTable\__Initalize
          i+1
        EndIf
        *VTable=*VTable\__VTable_parent
      Wend  
      
      While i>0
        i-1
        CallFunctionFast(*saveInitalize(i),*self)
      Wend     
      ;EndIf  
    EndProcedure
    
    Procedure __Disp (*self.object__Class__struc)
      Define *VTable.object__Class__VTable
      
      *VTable=*self\__VTable
      
      While *VTable
        If *VTable\__Dispose
          CallFunctionFast(*VTable\__Dispose,*self)
        EndIf
        *VTable=*VTable\__VTable_parent
      Wend  
      
      If *self\__properties_chain
        dispose_chain(*self\__properties_chain)
      EndIf
      
      *self\__VTable=0     
    EndProcedure
    
    Procedure.s GetClassName (*self.object__Class__struc)
      ProcedureReturn PeekS(*self\__VTable\__classname)
    EndProcedure
    
    Procedure __CheckClass (*self.object__Class__struc,*table)
      Define *VTable.object__Class__VTable
      *VTable=*self\__VTable
      
      If *table=object__Class__functions
        ProcedureReturn *self
      EndIf
      
      
      While *VTable
        If *table=*VTable
          ProcedureReturn *self
        EndIf
        *VTable=*VTable\__VTable_parent
      Wend
      
      ProcedureReturn #Null
    EndProcedure
    
    Procedure Size (*self.object__Class__struc)
      ProcedureReturn *self\__vtable\__size
    EndProcedure
    
    CompilerIf #PB_Compiler_Debugger
      Procedure __DebugOut (*self.object__Class__struc,message.s)
        Debug message +": "+*self\__objname+"."+PeekS(*self\__VTable\__ClassName)+" "+*self\__creationfile+"@"+Str(*self\__creationline)
      EndProcedure
    CompilerEndIf
    ;}
    ;-
    
    ;-
    ;-{ Debug all objects
    CompilerIf #debug_all_objects And #PB_Compiler_Debugger
      Structure Class_debug
        *obj
        line.s
      EndStructure
      
      Global NewList allobj.Class_debug()
      Procedure addobj(*obj.object)
        Protected *obj_struc.object__Class__struc=*obj
        AddElement(allobj())
        allobj()\obj=*obj
        allobj()\line=*obj_struc\__objname+"."+PeekS(*obj_struc\__VTable\__ClassName)+" "+*obj_struc\__creationfile+"@"+Str(*obj_struc\__creationline)
        
      EndProcedure
      Procedure subobj(*obj.object)
        ForEach (allobj())
          If allobj()\obj=*obj
            DeleteElement(allobj())
            Break
          EndIf
        Next
      EndProcedure
      Procedure listobj()
        ForEach allobj()
          Debug "[WARNING] Missing dispose: "+allobj()\line
        Next    
      EndProcedure
    CompilerEndIf
    ;}
    ;-
    
    
  EndModule
  
  ;- ***
  ;- *** Module EnableClass
  ;- ***
  
  DeclareModule EnableClass
    EnableExplicit
    
    #PB_Class=#PB_Interface
    
    ;-
    ;-{ Declaration and Definition
    
    Macro Class(ClassName):   ;EndIndent
      
      CompilerIf Not #PB_Compiler_Procedure="" Or Defined(__Class__BeyondEnd,#PB_Constant)    
        CompilerError "Don't define Class after _End or in Procedures"
      CompilerEndIf  
      
      DataSection     
        ClassName#__Class__Name:
        Data.s oop::CreateQuote(ClassName)
      EndDataSection  
      
      oop::CreateMacro(__currentClass(),ClassName)    
    EndMacro
    
    Macro DeclareClass(ClassName):;EndIndent
      Class(ClassName):           ;EndIndent
    EndMacro
    
    Macro DefineClass(ClassName):  ;EndIndent
      CompilerIf Not #PB_Compiler_Procedure="" Or Defined(__Class__BeyondEnd,#PB_Constant)    
        CompilerError "Don't define Class after _End or in Procedures"
      CompilerEndIf
      
      oop::CreateMacro(__currentClass(),ClassName)   
    EndMacro
    
    Macro ParentClass(ClassName)
      oop::CreateMacro(__parentClass(), ClassName)
    EndMacro
    
    Macro DeclareMethods  :    ;EndIndent
      CompilerIf oop::CreateQuote(__parentClass()) = "__parentClass()"
        
        Interface __currentClass() Extends oop::object:      ;EndIndent
        
      CompilerElse
        Interface __currentClass() Extends __parentClass():  ;EndIndent
        
      CompilerEndIf
      
    EndMacro
    
    Macro Properties   
      EndInterface  ;Indent
      
      CompilerIf oop::CreateQuote(__parentClass()) = "__parentClass()"
        Structure __currentClass()__Class__struc Extends oop::object__Class__struc     : ;EndIndent
        
      CompilerElse
        Structure __currentClass()__Class__struc Extends __parentClass()__Class__struc : ;EndIndent
        
      CompilerEndIf
      
    EndMacro
    
    Macro Methods  
      EndStructure: ;Indent
      Structure __currentClass()__Class__substruc
        offset.l
        struc.__currentClass()__Class__struc
      EndStructure
      
      Structure __currentClass()__Class__VTable extends oop::object__Class__VTable
        space.b[SizeOf( __currentClass() )-SizeOf(oop::object__Class__VTable)]
      EndStructure 
      Global __currentClass()__Class__functions.__currentClass()__Class__VTable
      
      CompilerIf oop::CreateQuote(__parentClass()) <> "__parentClass()"
        CopyMemory(__parentClass()__Class__functions,__currentClass()__Class__functions,SizeOf( __parentClass() ))
        __currentClass()__Class__functions\__VTable_parent= __parentClass()__Class__functions
        __currentClass()__Class__functions\__Initalize=0
        __currentClass()__Class__functions\__Dispose=0
        __currentClass()__Class__functions\__Clone=0
        
      CompilerElse
        CopyMemory(oop::object__Class__functions,__currentClass()__Class__functions,SizeOf( oop::object ))
        
      CompilerEndIf  
      __currentClass()__Class__functions\__deep+1
      __currentClass()__Class__functions\__classname=?__currentClass()__Class__Name
      __currentClass()__Class__functions\__size=SizeOf(__currentClass()__Class__struc )
    EndMacro 
    
    Macro EndDeclareClass    ;Indent  
    Methods                  ;Indent
      
      UndefineMacro __currentClass
      UndefineMacro __parentClass
    EndMacro
    
    
    Macro Method(ret,func,p1=,p2=,p3=,p4=,p5=,p6=,p7=,p8=,p9=,p10=) ;EndIndent
      CompilerIf      oop::CreateQuote(p1)=""
        Procedure.ret  __currentClass()__Class__#func(*self.__currentClass()__Class__struc) ;EndIndent
      CompilerElseIf oop::CreateQuote(p2)=""
        Procedure.ret  __currentClass()__Class__#func(*self.__currentClass()__Class__struc,p1)  ;EndIndent
      CompilerElseIf oop::CreateQuote(p3)=""
        Procedure.ret  __currentClass()__Class__#func(*self.__currentClass()__Class__struc,p1,p2)  ;EndIndent
      CompilerElseIf oop::CreateQuote(p4)=""
        Procedure.ret  __currentClass()__Class__#func(*self.__currentClass()__Class__struc,p1,p2,p3)  ;EndIndent
      CompilerElseIf oop::CreateQuote(p5)=""
        Procedure.ret  __currentClass()__Class__#func(*self.__currentClass()__Class__struc,p1,p2,p3,p4)  ;EndIndent
      CompilerElseIf oop::CreateQuote(p6)=""
        Procedure.ret  __currentClass()__Class__#func(*self.__currentClass()__Class__struc,p1,p2,p3,p4,p5)  ;EndIndent
      CompilerElseIf oop::CreateQuote(p7)=""
        Procedure.ret  __currentClass()__Class__#func(*self.__currentClass()__Class__struc,p1,p2,p3,p4,p5,p6)  ;EndIndent
      CompilerElseIf oop::CreateQuote(p8)=""
        Procedure.ret  __currentClass()__Class__#func(*self.__currentClass()__Class__struc,p1,p2,p3,p4,p5,p6,p7)  ;EndIndent
      CompilerElseIf oop::CreateQuote(p9)=""
        Procedure.ret  __currentClass()__Class__#func(*self.__currentClass()__Class__struc,p1,p2,p3,p4,p5,p6,p7,p8)  ;EndIndent
      CompilerElseIf oop::CreateQuote(p10)=""
        Procedure.ret  __currentClass()__Class__#func(*self.__currentClass()__Class__struc,p1,p2,p3,p4,p5,p6,p7,p8,p9)  ;EndIndent
      CompilerElse
        Procedure.ret  __currentClass()__Class__#func(*self.__currentClass()__Class__struc,p1,p2,p3,p4,p5,p6,p7,p8,p9,p10)  ;EndIndent
      CompilerEndIf
      Protected self.__currentClass()=*self
      
      oop::CreateMacro(__currentfunc(),func)
    EndMacro
    
    Macro MethodReturn
      _ProcedureReturn
    EndMacro
    
    Macro EndMethod 
      ;Indent
      _EndProcedure ;Indent
      CompilerIf oop::CreateQuote(__currentfunc())="Initalize" Or oop::CreateQuote(__currentfunc())="initalize" Or  oop::CreateQuote(__currentfunc())="Dispose" Or oop::CreateQuote(__currentfunc())="dispose" Or oop::CreateQuote(__currentfunc())="Clone" Or oop::CreateQuote(__currentfunc())="clone"
        __currentClass()__Class__functions\__#__currentfunc() =@__currentClass()__Class__#__currentfunc() ()
      CompilerElse
        PokeI(__currentClass()__Class__functions+OffsetOf(__currentClass()\__currentfunc() ()),@__currentClass()__Class__#__currentfunc() ())
      CompilerEndIf  
      UndefineMacro __currentfunc
    EndMacro
    
    Macro AliasMethod(oldfunc,newfunc)
      PokeI(__currentClass()__Class__functions+OffsetOf(__currentClass()\newfunc ()), PeekI(__currentClass()__Class__functions+OffsetOf(__currentClass()\oldfunc ())))
    EndMacro
    
    Macro EndClass  ;Indent
                    ;Indent
      Procedure __currentClass()__Class____CopyStructure(*source,*new)
        ProcedureReturn CopyStructure(*source,*new,__currentClass()__Class__struc) 
      EndProcedure
      __currentClass()__Class__functions\__CopyStructure=@__currentClass()__Class____CopyStructure()
      Procedure __currentClass()__Class____AllocateStructure(*self)
        ProcedureReturn AllocateStructure(__currentClass()__Class__struc)
      EndProcedure
      __currentClass()__Class__functions\__AllocateStructure=@__currentClass()__Class____AllocateStructure()
      
      Procedure __currentClass()__Class____ResetStructure(*self)
        ClearStructure(*self,__currentClass()__Class__struc)
        InitializeStructure(*self,__currentClass()__Class__struc)
      EndProcedure
      __currentClass()__Class__functions\__ResetStructure=@__currentClass()__Class____ResetStructure()
      
      
      UndefineMacro __currentClass
      UndefineMacro __parentClass
      
    EndMacro
    
    Macro EndDefineClass 
      EndClass ;Indent ;Indent ;Indent
    EndMacro
    ;}
    ;-
    
    ;-
    ;-{ Object Creation and Destruction
    
    
    CompilerIf #PB_Compiler_Debugger  
      Macro Allocate_Object(ClassName)
        oop::Obj_init(ClassName#__Class__functions,SizeOf(ClassName#__Class__struc),AllocateStructure(ClassName#__Class__struc),"*allocate",#PB_Compiler_Line,#PB_Compiler_File)
      EndMacro
    CompilerElse
      Macro Allocate_Object(ClassName)
        oop::Obj_init(ClassName#__Class__functions,SizeOf(ClassName#__Class__struc),AllocateStructure(ClassName#__Class__struc))
      EndMacro
    CompilerEndIf
    
    Declare Free_Object(*obj.oop::object)
    
    Macro Protected_Object(obj,ClassName)
      oop::newobj(Protected,obj,ClassName,Define)
    EndMacro
    Macro Global_Object(obj,ClassName)
      CompilerIf #PB_Compiler_Procedure="" And Not Defined(__Class__BeyondEnd,#PB_Constant)
        oop::newobj(Global,obj,ClassName,Global)
      CompilerElse
        CompilerError "Don't create global obj in procedures or after _END !"
      CompilerEndIf
      
    EndMacro
    Macro Define_Object(obj,ClassName)
      oop::newobj(Define,obj,ClassName,Define)
    EndMacro
    
    Macro Static_Object(obj,ClassName)
      oop::newobj(Static,obj,ClassName,Global)
    EndMacro
    
    Macro Declare_Object(obj,ClassName,size=1);for properties
      obj#__Class__obj.ClassName#__Class__substruc[size]
      obj.ClassName[size]
    EndMacro
    
    
    Macro Initalize_Object(obj,ClassName,size=1);for properties
      Define i__class__position
      For i__class__position=0 To size-1
        If *self\obj[i__class__position]=0
          *self\obj[i__class__position]=*self\obj#__Class__obj[i__class__position]\struc
          
          *self\obj#__Class__obj[i__class__position]\offset=OffsetOf(__currentClass()__Class__struc\obj)+SizeOf(integer)*i__class__position
          
          *self\obj#__Class__obj[i__class__position]\struc\__VTable=ClassName#__Class__functions
          CompilerIf #PB_Compiler_Debugger
            *self\obj#__Class__obj[i__class__position]\struc\__objname=*self\__objname+"."+oop::CreateQuote(__currentClass()\obj)+"["+Str(i__class__position)+"]"
            *self\obj#__Class__obj[i__class__position]\struc\__creationline=#PB_Compiler_Line
            *self\obj#__Class__obj[i__class__position]\struc\__creationfile=#PB_Compiler_File
            oop::addobj(*self\obj[i__class__position])
          CompilerEndIf 
          *self\obj[i__class__position]\__init()
          
          
          *self\obj#__Class__obj[i__class__position]\struc\__dispose_chain=*self\__properties_chain
          *self\__properties_chain=*self\obj[i__class__position]
          
          CompilerIf #PB_Compiler_Debugger
            oop::counter__object+1
          CompilerEndIf
        EndIf     
      Next
    EndMacro
    
    
    ;}
    ;-
    
    ;-
    ;-{ Command replace
    Macro _FakeEnd
      CompilerIf oop::CreateQuote(__Class__endprocedurecheck()) = "fail" 
        CompilerError "missing _EndProcedure or _ProcedureReturn above this line!"
      CompilerEndIf   
      
      oop::Dispose_global_obj()
      oop::Dispose_local_obj()  
      CompilerIf #PB_Compiler_Debugger
        If oop::counter__object
          Debug "[WARNING] not disposed objects: "+Str(oop::counter__object)
        EndIf
        If oop::counter__allocate__object
          Debug "[WARNING] not disposed allocated objects: "+Str(oop::counter__allocate__object)
        EndIf
        oop::listobj()    
      CompilerEndIf
      Debug "[INFO] _end"
    EndMacro
    Macro _End
      _FakeEnd
      #__Class__BeyondEnd=#True
      End
    EndMacro
    
    Macro _EndProcedure 
      oop::Dispose_local_obj()  ;Indent
      UndefineMacro __Class__endprocedurecheck
      EndProcedure  ;Indent
    EndMacro
    
    Macro _ProcedureReturn
      oop::Dispose_local_obj()
    ProcedureReturn ;EndIndent
  EndMacro
  ;}
  ;-
  
  ;-
  ;-{ Class handling
  
  Macro Object_ForceClass(obj,ClassName)
    If obj\__CheckClass(ClassName#__Class__functions) = #False
      CompilerIf #PB_Compiler_Debugger  
        obj\__DebugOut( "[ERROR] Wrong Class, expected" + oop::CreateQuote(ClassName))
        CallDebugger
      CompilerEndIf
      End
    EndIf
  EndMacro
  
  
  Macro Object_CheckClass(obj,ClassName)
    obj\__CheckClass(ClassName#__Class__functions)
  EndMacro
  
  
  Macro SizeOf_Class(ClassName)
    SizeOf(ClassName#__Class__struc)
  EndMacro
  
  Macro DebugCreate_Obj(obj,message)
    CompilerIf #PB_Compiler_Debugger
      obj\__DebugOut(message)
    CompilerEndIf  
  EndMacro
  
  
  
  ;}
  ;-
EndDeclareModule

Module EnableClass
  Procedure Free_Object(*obj.oop::object)
    If *obj
      *obj\__disp()
      CompilerIf #PB_Compiler_Debugger
        oop::counter__allocate__object-1
        oop::subobj(*obj)
      CompilerEndIf
      FreeStructure(*obj)
      
    EndIf
  EndProcedure
EndModule

UseModule EnableClass

Re: Module oop und EnableClass

Verfasst: 06.09.2015 10:12
von GPI
Und hier noch ein Beispiel.
Genauer gesagt, ist das meine Test-Datei um Fehler in der Class-Handharbung zu finden. Wenn eines der Test fail geht, dann stimmt was in der modul_oop.pbi nicht!

Code: Alles auswählen

;-***
;-*** TEST
;-***

CompilerIf #PB_Compiler_IsMainFile
  EnableExplicit
  
  Global NewMap _fakealloc()
  
  Procedure fakealloc()
    Static c.i
    c+1
    _fakealloc(Str(c))=1
    ProcedureReturn c
  EndProcedure
  Procedure fakefree(c)
    If _fakealloc(Str(c))>0
      _fakealloc(Str(c))=0
    Else
      _fakealloc(Str(c))=-1
    EndIf
    
  EndProcedure
  Procedure listfake()
    Define ok=#True
    ForEach _fakealloc()
      If _fakealloc()<>0
        ok=#False
      EndIf
    Next
    ProcedureReturn ok
  EndProcedure
  Procedure falidFake(c)
    ProcedureReturn Bool(_fakealloc(Str(c))>0)
  EndProcedure
  
  
  Global TestResult=#True
  
  Global TestName.s
  
  Macro Test(a,ss,c)
    Define __aa=a,__cc=c
    _Test(#PB_Compiler_Procedure,Bool(__aa ss __cc),oop::CreateQuote(a ss c),Str(__aa),Str(__cc),oop::CreateQuote(ss))
  EndMacro
  Macro TestS(a,ss,c)
    Define __aas.s=a,__ccs.s=c
    _Test(#PB_Compiler_Procedure,Bool(__aas ss __ccs),oop::CreateQuote(a ss )+" "+__ccs,"",""," ")
  EndMacro
  
  
  Procedure _Test(p.s,bool.i,sa.s,a.s,c.s,s.s)
    If s="<>":s="!":EndIf
    Static back,lastp$,lastTestName$
    Define fc,cok,cfail
    
    If lastTestName$<>TestName
      lastTestName$=TestName
      ConsoleColor(8,0)
      PrintN(TestName+":")
      lastp$=""
    EndIf
    
    If lastp$<>p
      lastp$=p
      ConsoleColor(8,0)
      If lastp$<>""
        PrintN("  ("+lastp$+")")
      Else
        PrintN("  (Main)")
      EndIf    
    EndIf
    
    Print ("     ")
    back!1
    If back
      fc=15
      cfail=12
      cok=10
    Else
      fc=7
      cfail=4
      cok=2    
    EndIf
    
    Define state.s
    ConsoleColor(fc,0)
    
    Print(Left(sa+Space(35+24),35+24) )
    
    Print(Left(Right(Space(5)+a,5)+s.s+Left(c+Space(5),5),11))
    If bool
      ConsoleColor(cok,0)
      PrintN("ok  ")
      ConsoleColor(fc,0)
    Else
      ConsoleColor(cfail,0)
      PrintN("FAIL")
      ConsoleColor(fc,0)
      TestResult=#False
    EndIf  
    ConsoleColor(7,0)
  EndProcedure
  
  Global Init_test.i=1
  Global Clone_test.i=1
  
  
  Class(cTestParent);- cTestParent
    DeclareMethods
    Properties
    Methods
      Method(i,Initalize)
        init_test+1
      EndMethod
      Method(i,Dispose)
        init_test-3
      EndMethod
      Method(i,Clone)
        Clone_test+2
        MethodReturn #True
      EndMethod
      
  EndClass
  
  Class(cTestChild);- cTestChild
    ParentClass(cTestParent)
    DeclareMethods
      get()
    Properties
      *fakemem
    Methods
      Method(i,Initalize)
        init_test*2
        *self\fakemem=fakealloc()
      EndMethod
      Method(i,Dispose)
        init_test*4
        fakefree(*self\fakemem)
        *self\fakemem=0
      EndMethod
      Method(i,Clone)
        ;*old=*self\fakmem
        *self\fakemem=fakealloc()
        ;copy *old\fakemem to *self\fakemem
        Clone_Test*3
        MethodReturn #True
      EndMethod        
      Method(i,get)
        MethodReturn *self\fakemem
      EndMethod    
  EndClass
  
  Class(cTestGrandChild);- cTestGrandchild
    ParentClass(cTestChild)
    DeclareMethods
      getvar()
      setvar(v.i)
    Properties
      value.i
    Methods
      Method(i,Initalize)
        init_test+6
      EndMethod
      Method(i,Dispose)
        init_test-2
      EndMethod
      Method(i,Clone)      
        Clone_test+9
        MethodReturn #True
      EndMethod
      Method(i,GetVar)
        MethodReturn *self\value
      EndMethod
      Method(i,SetVar,v.i)
        *self\value=v
      EndMethod
      
  EndClass
  
  Class(cTestChild2);- cTestChild2
    ParentClass(cTestParent)
    DeclareMethods
    Properties
    Methods
      Method(i,Initalize)
        init_test*5
      EndMethod
      Method(i,Dispose)
        init_test*13
      EndMethod
      Method(i,Clone)
        Clone_test*7
        MethodReturn #True
      EndMethod
  EndClass
  
  Class(cTestCloneFail);- cTestCloneFail
    ParentClass(cTestGrandChild)
    DeclareMethods
    Properties
    Methods
      Method(i,Clone)
        MethodReturn #False
      EndMethod
      
  EndClass
  
  Class(cVar);- cVar
    DeclareMethods
      Set(x)
      Get()
    Properties
      value.i
    Methods
      Method(i,Set,x.i)
        *self\value=x
      EndMethod
      Method(i,Get)
        MethodReturn *self\value
      EndMethod
  EndClass
  
  Class(cVar2);- cVar2
    ParentClass(cVar)
    DeclareMethods
      OldSet(x)
    Properties
    Methods
      AliasMethod(Set,OldSet)
      Method(i,Set,x)
        *self\value=x*2
      EndMethod
  EndClass
  
  
  Class(CSubs);- cSubs
    DeclareMethods
      Get(w.i)
      Set(w.i,v.i)
    Properties
      Declare_Object(Var,cVar)
      Declare_Object(Var2,cVar)
    Methods
      Method(i,Initalize);--Initalize
        Initalize_Object(Var,cVar)
        Initalize_Object(Var2,cVar)
      EndMethod
      Method(i,Get,w.i);--Get
        If w=1
          MethodReturn *self\Var\Get()
        EndIf
        MethodReturn *self\Var2\Get()
      EndMethod
      Method(i,Set,w.i,v.i);--Set
        If w=1
          MethodReturn *self\Var\Set(v)
        EndIf
        MethodReturn *self\Var2\Set(v)
      EndMethod
  EndClass
  
  Class(CSubs2);- cSubs2
    DeclareMethods
      Get(w.i)
      Set(w.i,v.i)
    Properties
      Declare_Object(Var,cVar,2)
    Methods
      Method(i,Initalize)
        Initalize_Object(Var,cVar,2)
      EndMethod
      Method(i,Get,w.i)
        MethodReturn *self\Var[w-1]\Get()
      EndMethod
      Method(i,Set,w.i,v.i)
        MethodReturn *self\Var[w-1]\Set(v)
      EndMethod
  EndClass
  
  Class(cDeep1);- cDeep1
    DeclareMethods
      get()
      set(v.i)
      GetFake()
    Properties
      *fakemem
      value.i
    Methods
      Method(i,Initalize)
        *self\fakemem=fakealloc()
      EndMethod
      Method(i,Dispose)
        fakefree(*self\fakemem)
        *self\fakemem=0
      EndMethod
      Method(i,Clone)
        *self\fakemem=fakealloc()
        ;copy *old\fakemem to *self\fakemem
        MethodReturn #True
      EndMethod   
      Method(i,Set,v.i)
        *self\value=v
      EndMethod
      Method(i,Get)
        MethodReturn *self\value
      EndMethod
      Method(i,GetFake)
        MethodReturn *self\fakemem
      EndMethod    
  EndClass
  Class(cDeep2);- cDeep2
    DeclareMethods
      get(p.i)
      set(p.i,v.i)
      GetFake(p.i)
    Properties
      *fakemem
      value.i
      Declare_Object(var,cDeep1,2);we use only the first one, the second is only for "fakemem"-tests
    Methods
      Method(i,Initalize)
        Initalize_Object(var,cDeep1,2)      
        *self\fakemem=fakealloc()
      EndMethod
      Method(i,Dispose)
        fakefree(*self\fakemem)
        *self\fakemem=0
      EndMethod
      Method(i,Clone)
        *self\fakemem=fakealloc()
        ;copy *old\fakemem to *self\fakemem
        MethodReturn #True
      EndMethod   
      Method(i,Set,p.i,v.i)
        If p=1
          *self\var\set(v)
        Else
          *self\value=v
        EndIf      
      EndMethod
      Method(i,Get,p.i)
        If p=1
          MethodReturn *self\var\get()
        Else
          MethodReturn *self\value
        EndIf      
      EndMethod
      Method(i,GetFake,p)
        If p=1
          MethodReturn *self\var\getfake()
        Else
          MethodReturn *self\fakemem
        EndIf
      EndMethod
  EndClass
  Class(cDeep3);- cDeep3
    DeclareMethods
      get(p.i)
      set(p.i,v.i)
      GetFake(p.i)
    Properties
      *fakemem
      value.i
      Declare_Object(var,cDeep2)
    Methods
      Method(i,Initalize)
        Initalize_Object(var,cDeep2)
        *self\fakemem=fakealloc()
      EndMethod
      Method(i,Dispose)
        fakefree(*self\fakemem)
        *self\fakemem=0
      EndMethod
      Method(i,Clone)
        *self\fakemem=fakealloc()
        ;copy *old\fakemem to *self\fakemem
        MethodReturn #True
      EndMethod   
      Method(i,Set,p.i,v.i)
        If p=1 Or p=2
          *self\var\set(p,v)
        Else
          *self\value=v
        EndIf      
      EndMethod
      Method(i,Get,p.i)
        If p=1 Or p=2
          MethodReturn *self\var\get(p)
        Else
          MethodReturn *self\value
        EndIf      
      EndMethod
      Method(i,GetFake,p)
        If p=1 Or p=2
          MethodReturn *self\var\getfake(p)
        Else
          MethodReturn *self\fakemem
        EndIf
      EndMethod
  EndClass
  Class(cDeep4);- cDeep4
    DeclareMethods
      get(p.i)
      set(p.i,v.i)
      GetFake(p.i)
      GetFake2()
    Properties
      *fakemem
      Declare_Object(var,cDeep3)
    Methods
      Method(i,Initalize)
        Initalize_Object(var,cDeep3)
        *self\fakemem=fakealloc()
      EndMethod
      Method(i,Dispose)
        fakefree(*self\fakemem)
        *self\fakemem=0
      EndMethod
      Method(i,Clone)
        *self\fakemem=fakealloc()
        ;copy *old\fakemem to *self\fakemem
        MethodReturn #True
      EndMethod   
      Method(i,Set,p.i,v.i)
        MethodReturn *self\var\set(p,v)
      EndMethod
      Method(i,Get,p.i)
        MethodReturn *self\var\get(p)
      EndMethod
      Method(i,GetFake,p.i)      
        MethodReturn *self\var\getfake(p)
      EndMethod
      Method(i,GetFake2)
        MethodReturn *self\fakemem
      EndMethod    
  EndClass
  Class(cDeep5);- cDeep5
    ParentClass(cDeep4)
    DeclareMethods
      GetFake3()
    Properties
      *fakemem2
      Declare_Object(var2,cDeep3)
    Methods
      Method(i,Initalize)
        Initalize_Object(var2,cDeep3)
        *self\fakemem2=fakealloc()
      EndMethod
      Method(i,Dispose)
        fakefree(*self\fakemem2)
        *self\fakemem2=0
      EndMethod
      Method(i,Clone)
        *self\fakemem2=fakealloc()
        ;copy *old\fakemem to *self\fakemem
        MethodReturn #True
      EndMethod   
      Method(i,Set,p.i,v.i)
        If p<4
          *self\var\set(p,v)
        Else
          *self\var2\set(p-3,v)
        EndIf      
      EndMethod
      Method(i,Get,p.i)
        If p<4
          MethodReturn *self\var\get(p)
        Else
          MethodReturn *self\var2\get(p-3)
        EndIf      
      EndMethod
      Method(i,GetFake3)
        MethodReturn *self\fakemem2
      EndMethod    
  EndClass
  
  
  ;clonefrom überprüfen
  
  
  
  
  
  OpenConsole()
  EnableGraphicalConsole(1)
  ConsoleColor(7,0)
  ClearConsole()
  
  TestName="Initialize Tests";-{ Initalize Tests
  Procedure InitTest1()
    Define_Object(obj1,cTestParent)
    test(Init_Test,=,2)
    Define_Object(obj2,cTestChild)
    test(Init_Test,=,6)
    Define_Object(obj3,cTestGrandChild)
    test(Init_Test,=,20)
    Define_Object(obj5,cTestChild2)
    test(Init_Test,=,105)
  _EndProcedure
  InitTest1()
  ;}
  
  TestName="Disopse Tests";-{ Dispose Tests
  Procedure DisposeTest1()
    Protected_Object(obj1,cTestGrandChild)
    test(Init_Test,=,48)
  _EndProcedure
  Procedure DisposeTest2()
    Protected_Object(obj1,cTestChild2)
    test(Init_Test,=,910)
  _EndProcedure
  Init_test=20
  DisposeTest1()
  Test(Init_Test,=,181)
  DisposeTest2()
  Test(Init_Test,=,11827)
  ;}
  
  TestName="Clone Tests";-{ Clone Tests
  Procedure CloneTest1()
    Protected i
    Protected *mem1,*mem2
    Protected_Object(obj1,cTestGrandChild)
    Protected_Object(obj2,cTestGrandChild)
    Protected_Object(obj3,cTestParent)
    *mem1=obj1\get()
    *mem2=obj2\get()
    Init_Test=54
    Clone_Test=1
    test(obj1\CloneFrom(obj2),=,#True)
    test(Init_test,=,205)
    test(Clone_Test,=,18)
    
    test(obj1\get(),<>,obj2\get())
    test(obj1\get(),<>,*mem1)
    test(obj2\get(),=,*mem2)
    test(falidfake(obj1\get()),=,#True)
    test(falidfake(obj2\get()),=,#True)
    
    obj1\setvar(99)
    test(obj1\CloneFrom(obj3),=,#False)
    test(obj1\getvar(),=,0)
    obj1\setvar(99)
    test(obj1\CloneFrom(obj1),=,#False)
    test(obj1\getvar(),=,0)
  _EndProcedure
  Procedure CloneTest2()
    Protected_Object(obj1,cVar)
    Protected_Object(obj2,cvar)
    obj1\Set(1)
    obj2\Set(2)
    obj1\CloneFrom(obj2)
    Test(obj1\Get(),=,2)
    obj1\Set(3)
    Test(obj2\Get(),=,2)
  _EndProcedure
  Procedure CloneTest3()
    init_test=0
    Protected_Object(obj1,cTestCloneFail)
    Protected_Object(obj2,cTestCloneFail)
    
    
    obj2\setvar(99)
    test(obj2\CloneFrom(obj1),=,#False)
    test(obj2\getvar(),=,0)
    init_Test=1
    test(obj2\AllocateClone(),=,#False)
    test(Init_test,=,-7)
    
  _EndProcedure
  
  test(listfake(),=,#True)
  CloneTest1()
  
  test(listfake(),=,#True)
  CloneTest2()
  
  
  test(listfake(),=,#True)
  CloneTest3()
  
  test(listfake(),=,#True)
  
  ;}
  
  TestName="Global Tests";-{ Global Tests
  Global_Object(gVar,cVar)
  Procedure GlobalTest1()
    gvar\Set(gvar\get()+1)
  _EndProcedure
  gvar\set(20)
  globalTest1()
  test(gvar\get(),=,21)
  ;}
  
  TestName="Bad Obj1=Obj2 Test";-{ Bad Test
  Procedure BadSet()
    Protected_Object(obj1,cVar)
    Protected_Object(obj2,cVar)
    obj1\set(10)
    obj2\set(20)
    obj1=obj2
    test(obj1\Get(),=,obj2\get())
    
  _EndProcedure
  BadSet()
  ;}
  
  TestName="Pointer Tests";-{ Pointer Test
  Procedure pointer(*obj.cVar)
    test(Object_CheckClass(*obj,cVar),<>,#False)
    Object_ForceClass(*obj,cVar)
    If Not Object_CheckClass(*obj,cVar)
      ProcedureReturn
    EndIf
    
    *obj\set(*obj\get()+10)
    
  _EndProcedure
  Define_Object(pointer1,cvar)
  Define_Object(pointer2,cTestParent)
  pointer(pointer1)
  test(pointer1\Get(),=,10)
  pointer(pointer1)
  test(pointer1\Get(),=,20)
  ;}
  
  TestName="Recursive Test";-{ Recursive Test
  Procedure recursive(*obj.cvar)
    Protected_Object(obj2,cvar)
    Protected x
    x=*obj\get()+1
    *obj\set(x)
    obj2\set(x)
    If *obj\get()<5
      recursive(*obj)
    EndIf
    test(obj2\get(),=,x)
  _EndProcedure
  pointer1\set(0)
  recursive(pointer1)
  test(pointer1\get(),=,5)
  ;}
  
  TestName="Loop Test";-{ Loop Test
  Procedure loop()
    Define i
    For i=1 To 10
      Define_Object(obj,cVar)
      obj\Set(obj\Get()+1)
    Next
    test(obj\Get(),=,10)
  _EndProcedure
  loop()
  ;}
  
  TestName="Static Test";-{ Static Test
  Procedure StaticTest(x)
    Static_Object(obj,cvar)
    obj\Set(obj\Get()+1)
    Test(obj\get(),=,x)  
  _EndProcedure
  StaticTest(1)
  StaticTest(2)
  ;}
  
  TestName="Check Class Test";-{ Check Class Test
  Procedure CheckTest()
    Protected_Object(obj1,cTestParent)
    Protected_Object(obj2,cTestChild)
    Protected_Object(obj3,cTestGrandChild)
    Protected_Object(obj4,cVar)
    Protected_Object(obj5,cTestChild2)
    test(Object_CheckClass(obj1,cTestParent),<>,0)
    test(Object_CheckClass(obj2,cTestParent),<>,0)
    test(Object_CheckClass(obj3,cTestParent),<>,0)
    test(Object_CheckClass(obj4,cTestParent),=,0)
    test(Object_CheckClass(obj5,cTestParent),<>,0)
    test(Object_CheckClass(obj1,cTestChild),=,0)
    test(Object_CheckClass(obj2,cTestChild),<>,0)
    test(Object_CheckClass(obj3,cTestChild),<>,0)
    test(Object_CheckClass(obj4,cTestChild),=,0)
    test(Object_CheckClass(obj5,cTestChild),=,0)
    test(Object_CheckClass(obj1,cTestGrandChild),=,0)
    test(Object_CheckClass(obj2,cTestGrandChild),=,0)
    test(Object_CheckClass(obj3,cTestGrandChild),<>,0)  
    test(Object_CheckClass(obj4,cTestGrandChild),=,0)
    test(Object_CheckClass(obj5,cTestGrandChild),=,0)
    test(Object_CheckClass(obj1,cVar),=,0)
    test(Object_CheckClass(obj2,cVar),=,0)
    test(Object_CheckClass(obj3,cVar),=,0)
    test(Object_CheckClass(obj4,cVar),<>,0)
    test(Object_CheckClass(obj5,cVar),=,0)
    test(Object_CheckClass(obj1,cTestChild2),=,0)
    test(Object_CheckClass(obj2,cTestChild2),=,0)
    test(Object_CheckClass(obj3,cTestChild2),=,0)
    test(Object_CheckClass(obj4,cTestChild2),=,0)
    test(Object_CheckClass(obj5,cTestChild2),<>,0)
  _EndProcedure
  CheckTest()
  ;}
  
  TestName="Modul Test";-{ Modul Test
  DeclareModule TestModul1
    UseModule EnableClass
    
    DeclareClass(cTM1)
      DeclareMethods
        Get()
        Set(v.i)
      Properties
        value.i
    EndDeclareClass
  EndDeclareModule
  Module TestModul1
    DefineClass(cTM1)
      Method(i,Get)
        MethodReturn *self\value
      EndMethod
      Method(i,Set,v.i)
        *self\value=v
      EndMethod
    EndDefineClass
  EndModule
  Procedure Test_Modul1()
    Protected_Object(obj1,TestModul1::cTM1)
    obj1\set(10)
    Test(obj1\get(),=,10)
  _EndProcedure
  
  DeclareModule TestModul2
    UseModule EnableClass
    Declare Output()
    Declare Output2()
  EndDeclareModule
  Module TestModul2
    Class(cTM2)
      ParentClass(TestModul1::cTM1)
      DeclareMethods
        Get2()
        Set2(v.i)
      Properties
        Value2.i
      Methods
        Method(i,Get2)
          MethodReturn *self\Value2
        EndMethod
        Method(i,Set2,v.i)
          *self\Value2=v
        EndMethod
    EndClass
    
    Global_Object(obj2,cTM2)
    
    Procedure Output()
      obj2\set(11)
      ProcedureReturn obj2\get()
    EndProcedure
    
    Procedure Output2()
      obj2\set2(22)
      ProcedureReturn obj2\get2()
    EndProcedure
  EndModule
  
  DeclareModule TestModul3
    UseModule EnableClass
    Global_Object(obj1,TestModul1::cTM1)
  EndDeclareModule
  Module TestModul3
    obj1\set(33)
  EndModule
  
  Test_Modul1()
  test(TestModul2::Output(),=,11)
  test(TestModul2::Output2(),=,22)
  test(TestModul2::Output(),=,11)
  test(TestModul2::Output2(),=,22)  
  test(TestModul3::obj1\get(),=,33)        
  ;}
  
  TestName="Allocate Test";-{ Allocate Test
  Procedure Allocate1()
    Define *obj.cVar
    *obj=Allocate_Object(cVar)
    *obj\set(912)
    test(*obj\get(),=,912)
    Free_Object(*obj)  
    *obj=0
  EndProcedure  
  Procedure Allocate2()
    Define *obj.cVar
    Define *obj2.cVar
    *obj=Allocate_Object(cVar)
    *obj\set(193)
    test(*obj\get(),=,193)
    *obj2=*obj\AllocateClone()
    test(*obj2\get(),=,193)
    
    Free_Object(*obj)
    test(*obj2\get(),=,193)
    Free_Object(*obj2)
  EndProcedure
  
  Allocate1()
  Allocate2()
  ;}
  
  TestName="Class Name Test";-{ Class Name Test
  Procedure ClassName()
    Define_Object(obj1,cTestParent)
    Define_Object(obj2,cTestChild)
    Define_Object(obj3,cTestGrandChild)
    Define_Object(obj4,cVar)
    tests(obj1\GetClassName(),=, "cTestParent")
    tests(obj2\GetClassName(),=, "cTestChild")
    tests(obj3\GetClassName(),=, "cTestGrandChild")
    tests(obj4\GetClassName(),=, "cVar")
  _EndProcedure
  ClassName()
  ;}
  
  TestName="Overwrite Method Test";-{ Overwrite Method Test
  Procedure Overwrite()
    Define_Object(obj1,cVar2)
    obj1\Set(30)
    test(obj1\Get(),=,60)
    obj1\OldSet(30)
    test(obj1\Get(),=,30)
    Define *obj.cVar=obj1
    *obj\Set(30)
    test(*obj\Get(),=,60)
    
  _EndProcedure
  Overwrite()
  ;}
  
  TestName="BaseClass Test";-{ BaseClass Test
  Procedure baseclass()
    Define_Object(obj1,cvar)
    obj1\set(30)
    
    Define *obj.oop::object
    Define *obj2.cvar
    Define *new.cVar
    *obj=obj1
    
    *new=*obj\AllocateClone()
    test(*new\get(),=,30)
    *new\set(20)
    test(*new\get(),=,20)
    test(obj1\get(),=,30)
    
    
    *obj=Allocate_Object(cVar)
    *obj\CloneFrom(*new)
    
    *obj2=*obj
    test(*obj2\get(),=,20)
    *obj2\set(10)
    test(*obj2\get(),=,10)
    test(*new\get(),=,20)
    
    tests(*obj\GetClassName(),=,"cVar")
    tests(*obj2\GetClassName(),=,"cVar")
    tests(*new\GetClassName(),=,"cVar")
    
    test(*obj\size(),=,sizeof_class(cVar))
    test(*obj2\size(),=,sizeof_class(cVar))
    test(*new\size(),=,sizeof_class(cVar))
    
    Free_Object(*obj)
    Free_Object(*new)
    
  _EndProcedure
  baseclass()
  ;}
  
  TestName="Objects in Class Test";-{ Objects in Class Test
  Procedure ObjInClass()
    Define_Object(obj,cSubs)
    Define_Object(obj2,cSubs)
    obj\Set(1,33)
    obj\Set(2,55)
    obj2\Set(1,233)
    obj2\Set(2,255)
    test(obj\Get(1),=,33)
    test(obj\Get(2),=,55)
    test(obj2\Get(1),=,233)
    test(obj2\Get(2),=,255)
  _EndProcedure
  Procedure ObjInClass2()
    Define_Object(obj,cSubs2)
    Define_Object(obj2,cSubs2)
    obj\Set(1,66)
    obj\Set(2,99)
    obj2\Set(1,266)
    obj2\Set(2,299)
    test(obj\Get(1),=,66)
    test(obj\Get(2),=,99)
    test(obj2\Get(1),=,266)
    test(obj2\Get(2),=,299)
    test(obj\clonefrom(obj2),=,#True)
    test(obj\Get(1),=,266)
    test(obj2\Get(1),=,266)
    obj\Set(1,399)
    test(obj\Get(1),=,399)
    test(obj2\Get(1),=,266)
    
    ;ProcedureReturn 0
  _EndProcedure
  Procedure ObjInClass3()
    Define_Object(obj,cDeep5)
    Define_Object(obj2,cDeep5)
    Define i
    For i=1 To 6
      obj\Set(i,i)
      obj2\set(i,i*10)
    Next
    For i=1 To 6
      test(obj\get(i),=,i)
      test(obj2\get(i),=,i*10)
      test(obj\getfake(i),<>,obj2\getfake(i))
    Next
    test(obj\getfake2(),<>,obj2\getfake2())
    test(obj\getfake3(),<>,obj2\getfake3())
    test(obj\CloneFrom(obj2),=,#True)
    For i=1 To 6
      test(obj\get(i),=,i*10)
      test(obj2\get(i),=,i*10)
      test(obj\getfake(i),<>,obj2\getfake(i))
    Next
    test(obj\getfake2(),<>,obj2\getfake2())
    test(obj\getfake3(),<>,obj2\getfake3())
    For i=1 To 6
      obj\Set(i,i)
    Next
    For i=1 To 6
      test(obj\get(i),=,i)
      test(obj2\get(i),=,i*10)
    Next
    test(obj\CloneFrom(obj),=,#False)
    For i=1 To 6
      test(obj\get(i),=,0)
      test(obj2\get(i),=,i*10)
    Next
  _EndProcedure
  Procedure ObjInClass4()
    Define_Object(obj,cDeep5)
    Define *obj2.cDeep5
    Define i
    For i=1 To 6
      obj\Set(i,i)
    Next
    *obj2=obj\AllocateClone()
    test(*obj2,<>,#False)
    If *obj2
      For i=1 To 6
        test(obj\get(i),=,i)
        test(*obj2\get(i),=,i)
        test(obj\getfake(i),<>,*obj2\getfake(i))
      Next
      test(obj\getfake2(),<>,*obj2\getfake2())
      test(obj\getfake3(),<>,*obj2\getfake3())
      For i=1 To 6
        *obj2\Set(i,i*10)
      Next
      For i=1 To 6
        test(obj\get(i),=,i)
        test(*obj2\get(i),=,i*10)
      Next
      
      Free_Object(*obj2)
    EndIf
  _EndProcedure
  
  ObjInClass()
  ObjInClass2()
  ObjInClass3()
  test(listfake(),=,#True)
  objinclass4()
  test(listfake(),=,#True)
  ;}
  
  TestName="Reset Test";-{ Reset Test
  Procedure ResetTest()
    Protected_Object(obj1,cVar)
    obj1\Set(20)
    test(Obj1\Get(),=,20)
    obj1\Reset()
    test(obj1\Get(),=,0)
  _EndProcedure
  ResetTest()
  ;}
  
  
  Procedure timetest1()
  EndProcedure
  Procedure timetest2()
    Define  var1.cvar__class__struc
    Define int.cvar
  EndProcedure
  Procedure timetest3()
    Define_Object(var1,cvar)
  _EndProcedure
  
  Define start=ElapsedMilliseconds()
  Define count=0
  
  
  
  
  _FakeEnd
  
  
  
  
  CompilerIf #PB_Compiler_Debugger
    TestName="All objects disposed?"
    test(oop::counter__object,=,0)
    test(oop::counter__allocate__object ,=,0)
    
    
  CompilerEndIf
  
  CompilerIf #False
    PrintN(Str( Sizeof_Class(cDeep1)))
    PrintN(Str( Sizeof_Class(cDeep2)))
    PrintN(Str( Sizeof_Class(cDeep3)))
    PrintN(Str( Sizeof_Class(cDeep4)))
    PrintN(Str( Sizeof_Class(cDeep5)))
  CompilerEndIf
  
  CompilerIf #False
    PrintN("")
    count=0
    start=ElapsedMilliseconds()
    Repeat
      timetest1()
      count+1  
    Until ElapsedMilliseconds()-start>100
    PrintN("Timetest1:"+count)
    
    count=0
    start=ElapsedMilliseconds()
    Repeat
      timetest2()
      count+1  
    Until ElapsedMilliseconds()-start>100
    PrintN("Timetest2:"+count)
    
    count=0
    start=ElapsedMilliseconds()
    Repeat
      timetest3()
      count+1  
    Until ElapsedMilliseconds()-start>100
    PrintN("Timetest3:"+count)
  CompilerEndIf
  
  
  
  
  PrintN("")
  PrintN("")
  If TestResult
    ConsoleColor(10,0)
    PrintN( "Test OK!")
  Else
    ConsoleColor(12,0)
    PrintN( "Test Fail!")  
  EndIf
  Input()
  CloseConsole()
  End
CompilerEndIf

Re: Module oop und EnableClass

Verfasst: 20.09.2015 21:54
von GPI
Ich hab das ganze etwas erweitert. Objekte in Klassen sind jetzt möglich (siehe Anleitung in ersten Post), Objekte können zurückgesetzt werden (Methode Reset()) und kleinere Code-Optimierungen.
In der Anleitung ist jetzt auch ein Bereich, wie man die IDE einstellen kann, damit die Formatierung der Klassen besser aussieht.

Re: Module oop und EnableClass

Verfasst: 28.10.2015 11:37
von NicTheQuick
Mir kommt das alles ganz schön überladen vor. Aber natürlich hast du auch an vieles gedacht.
Ich bastel auch gerade an sowas herum, aber das ist natürlich schon ein Krampf in Purebasic. Bei mir muss man die VirtualTable noch händisch schreiben, was mir aber relativ egal ist. :D Dafür brauche ich nur 200 Zeilen, aber ich muss auch noch viele Testfälle schreiben. Hab bisher nur zwei kleine Klassen gebaut.

Am schönsten wäre natürlich ein ordentlicher Precompiler. Aber ich bin schon zu faul den Lexer zu schreiben, geschweige denn einen vorhandenen zu konfigurieren. :lol:

Re: Module oop und EnableClass

Verfasst: 28.10.2015 19:40
von GPI
NicTheQuick hat geschrieben:Mir kommt das alles ganz schön überladen vor. Aber natürlich hast du auch an vieles gedacht.
Ich bastel auch gerade an sowas herum, aber das ist natürlich schon ein Krampf in Purebasic. Bei mir muss man die VirtualTable noch händisch schreiben, was mir aber relativ egal ist. :D Dafür brauche ich nur 200 Zeilen, aber ich muss auch noch viele Testfälle schreiben. Hab bisher nur zwei kleine Klassen gebaut.
Für mich gibt es zwei Punkte, die wichtig bei OOP sind: Vererbung und die Destruktoren. Für mich die beiden Merkmale warum ich das ganze überhaupt haben möchte. Hier seh ich die größten Vorteile gegenüber der "klassischen" Proceduren-methode. Und das lässt sich ohne Preprocessor nur etwas umständlich lösen. Ich wollte halt primär eine einfache Nutzung des ganzen. Und ich denke, das ist mir doch gelungen. Ein paar Sachen könnte man sicherlich auch rausnehmen. Bspw. das bei einer Objekterzeugung auch die Zeilennummer und Quelldatei gespeichert wird (nur bei aktivierten Debugger). Nur ich denke, das gerade diese Informationen zur Fehlersuche unglaublich praktisch sind. Ich denke da einen Destructor, der feststellt, das ein handle nicht ordnungsgemäß freigegeben wurde. Mit meinen Code ist es möglich, das er eine entsprechende Warnung in debug ausgibt und gleichzeitig angibt, wo das Objekt erzeugt wurde. Das dürfte die Fehlersuche deutlich vereinfachen.
Am schönsten wäre natürlich ein ordentlicher Precompiler. Aber ich bin schon zu faul den Lexer zu schreiben, geschweige denn einen vorhandenen zu konfigurieren. :lol:
An einen Preprocessor hab ich auch schon gedacht. Aber man muss da wirklich auf viel achten. Bspw. muss man sämtliche IncludeFiles überprüfen und einfügen. Wenn da noch Konstanten drin sind, dann wirds richtig aufwendig. Ich hatte schon die Idee mit der "Preprocess"-Funktion des Compilers zu arbeiten, das hat nur einen gigantischen Nachteil: Sobald ein Fehler da ist, bricht er sofort ab und erzeugt keine Datei. Die Declaration/Definition einer Klasse und die Benutzung wäre sicherlich so ein Fall.

Man könnte aber so wirklich einiges ein Programmcode einsparen. Allerdings glaub ich nicht, dass ein Programm wirklich sehr viel schneller wird, außer man definiert extrem viele Klassen und Objekte.

Übrigens ich hab den Code von oben auch noch in einer zweiten überarbeiten variante, die Syntax ändert sich dann aber ein stück:

Code: Alles auswählen

  DeclareClass(cDeep5,cDeep4);- cDeep5
    DeclareMethods
      GetFake3()
    EndDeclareMethods
    Properties
      *fakemem2
      Declare_Object(var2,cDeep3)
      EndProperties
  EndDeclareClass

Class(cDeep5)
      Method(i,Initalize)
        *self\fakemem2=fakealloc()
      EndMethod
      Method(i,Dispose)
        fakefree(*self\fakemem2)
        *self\fakemem2=0
      EndMethod
      Method(i,Clone)
        *self\fakemem2=fakealloc()
        ;copy *old\fakemem to *self\fakemem
        MethodReturn #True
      EndMethod   
      Method(i,Set,p.i,v.i)
        If p<4
          *self\var\set(p,v)
        Else
          *self\var2\set(p-3,v)
        EndIf      
      EndMethod
      Method(i,Get,p.i)
        If p<4
          MethodReturn *self\var\get(p)
        Else
          MethodReturn *self\var2\get(p-3)
        EndIf      
      EndMethod
      Method(i,GetFake3)
        MethodReturn *self\fakemem2
      EndMethod    
  EndClass
der Vorteil des neuen Systems wäre, das nach der Declaration der Klasse die Klasse vollständig einsatzbereit ist. Auch hab ich ein paar default-Methoden aus der object-Class entfernt und als eigenständige Proceduren implantiert. Statt obj\Reset() muss man jetzt ResetObject(obj) schreiben.
Grund des ganzen: A) ich wollte die Syntax mehr an PB angleichen. Die Klassen werden jetzt quasi ähnlich wie Module gehandhabt. b) Den Speicherverbrauch pro Objekt wird so reduziert. Und C) Objekte in Klassen müssen nicht mehr manuell initalisiert werden. Nachteil ist da leider, das unzählige Dummy-Structuren erzeugt werden - aber die erhöhen maximal die Compilerzeit.

Falls Interesse besteht, kann ich das ganze mal Posten. Übrigens: Das erste mal seit Jahrzehnten, das ich Goto/Gosub verwende. Ich muss bei der Declaration kurz in die Definition der Klasse springen, damit ich die VTABLE aufbauen kann. Anders ist es mit Macros nicht zu lösen.

Schade das Fred sich gegen OOP ausgesprochen hat. Mein Code beweist eigentlich, wie nahe PB schon ist, richtige Objekte zu unterstützen. Es wäre halt ein weiteres Werkzeug in der Kiste, wie man Probleme lösen kann. Man muss ja nicht gleich mit Operatorenüberladungen und Vererbung mit zwei Parents daherkommen. Die minimal-Lösung wie hier würde imo völlig ausreichen. Ist ja schließlich immer noch eine Basic-Variante und kein C++. Ich würde sogar übernehmen, das die Objekt-Eigenschaften/Member-Variablen nur innerhalb der Klasse änderbar sind. Das ist eh die besser sauberer Art und Weise.
Und ja, ich erkläre gerade hier ein Problem meines Codes zum Feature :)

Re: Module oop und EnableClass

Verfasst: 30.10.2015 10:41
von NicTheQuick
Ich hab noch ein paar Fragen:
  1. Macht dein clone() prinzipiell nur ein simples CopyStructure() oder steckt da mehr dahinter? Was ist z.B., wenn sich in der Objektstruktur weitere Objekte befinden, die ja tatsächlich nur als Pointer abgebildet werden?
  2. Kann man bei dir mehrere Konstruktoren erstellen?
  3. Kann man auf die Methoden des Parents zugreifen?
  4. Können nicht überschriebene Methoden einer Parent-Klasse auf überschriebene Methoden von der Child-Klasse zugreifen?
  5. Kann man den Standard-Konstruktor bei dir privat schalten, sodass man die Klasse selbst zwar nicht ableiten, aber über andere Konstruktoren instantiieren kann?
  6. Kann man bei dir Methoden schreiben, die automatisch einen Per-Object-Mutex sperren?
Bis auf Punkt 1 geht bei mir zumindest mal alles und ich finde es sehr praktisch. :)

Ich habe mir auch schon zwei Spezialklassen geschrieben. Eine Monitor-Klasse, die innerhalb von Synchronized-Methoden auch noch wait(), signal() und signalAll() kennt, womit man sehr einfach Thread-sichere Klassen durch Ableiten bauen kann. Und eine Thread-Klasse, die eine überschreibbare run-Methode hat, die als Thread ausgeführt wird, sobald man die start()-Methode aufruft. Ich habe mir beide Klassen so ein bisschen von Java abgeschaut. :wink:

Re: Module oop und EnableClass

Verfasst: 30.10.2015 10:55
von GPI
>Macht dein clone() prinzipiell nur ein simples CopyStructure() oder steckt da mehr dahinter? Was ist z.B., wenn sich in der
>Objektstruktur weitere Objekte befinden, die ja tatsächlich nur als Pointer abgebildet werden?

Basis ist immer ein CopyStructure. Aber mein Code beachtet auch Objekte - in der Fassung oben muss man ihn aber immer manuell Initalisieren. Wie gesagt, wenn du an meine zweite Variante interesse hast, sag bescheid.

>Kann man bei dir mehrere Konstruktoren erstellen?

Hier ist halt eine deutliche Einschränkung vorhanden. Mein Code unterstützt Konstruktoren (hier Initalize()) nur ohne Parameter. Child und Parents können natürlich eigene Konsruktoren haben.

>Kann man auf die Methoden des Parents zugreifen?

logisch.

>Können nicht überschriebene Methoden einer Parent-Klasse auf überschriebene Methoden von der Child-Klasse zugreifen?

Jup. Es gilt immer die vTable des Objekts. Und bei einen Child können die Einträge des Parents "überschrieben". Die einzelnen Methoden können ja nicht wählen welche vTable jetzt aktiv ist.

>Kann man den Standard-Konstruktor bei dir privat schalten, sodass man die Klasse selbst zwar nicht ableiten, aber über andere
>Konstruktoren instantiieren kann?

Geht nicht.

>Kann man bei dir Methoden schreiben, die automatisch einen Per-Object-Mutex sperren?

Was genau meinst du hier? Also automatisch geht es nicht, aber du kannst natürlich ein "Mutex" in den Properties speichern und dann bei jeder Methode ein LockMutex(*self\mutex) und UnLockMutex(*self\mutex) einfügen. Den Mutex muss man bei der Methode Initalize() erzeugen und mit "Dispose()" zerstören.

>Bis auf Punkt 1 geht bei mir zumindest mal alles und ich finde es sehr praktisch. :)

Da hab ich lange rumgefummelt, bis ich das hingekriegt hab.

Re: Module oop und EnableClass

Verfasst: 30.10.2015 10:58
von RSBasic
@GPI
Kannst du bitte Quote-Tags verwenden? Das Zitieren-Zeichen ">" sieht man kaum und ist bei vielen Zitierungen unübersichtlich.

Re: Module oop und EnableClass

Verfasst: 30.10.2015 14:06
von NicTheQuick
GPI hat geschrieben:>Macht dein clone() prinzipiell nur ein simples CopyStructure() oder steckt da mehr dahinter? Was ist z.B., wenn sich in der
>Objektstruktur weitere Objekte befinden, die ja tatsächlich nur als Pointer abgebildet werden?
Basis ist immer ein CopyStructure. Aber mein Code beachtet auch Objekte - in der Fassung oben muss man ihn aber immer manuell Initalisieren. Wie gesagt, wenn du an meine zweite Variante interesse hast, sag bescheid.
Nutzt du dann die Runtime Structures dafür?
>Kann man auf die Methoden des Parents zugreifen?
logisch.
Auch, wenn man sie überschrieben hat? Das geht nämlich bei mir, weil für jede Basisklasse eine eigene vTable existiert.
>Können nicht überschriebene Methoden einer Parent-Klasse auf überschriebene Methoden von der Child-Klasse zugreifen?
Jup. Es gilt immer die vTable des Objekts. Und bei einen Child können die Einträge des Parents "überschrieben". Die einzelnen Methoden können ja nicht wählen welche vTable jetzt aktiv ist.
Das geht schon. Angenommen man hat eine Klasse "Base" mit der Methode "test()", die ein "Debug 1" macht, und eine Klasse "Child", die "test()" mit "Debug 2" überschreibt, kann trotzdem "Child" aus jeder seiner Methoden mit "super()\test()" - oder falls weitere Parentklassen bestehen mit "super(Parent)\test()" - die überschriebenen Methoden nutzen. Wenn also innerhalb "Child" eine Methode "test2()" mit Inhalt "super()\test() : test()" existiert und diese von außen ausgerufen wird, werden beide Debug ausgegeben. :)
>Kann man den Standard-Konstruktor bei dir privat schalten, sodass man die Klasse selbst zwar nicht ableiten, aber über andere
>Konstruktoren instantiieren kann?
Geht nicht.
Ich fand das ganz praktisch, wenn man Klassen erstellen will, bei denen es keinen Sinn macht sie mit einem leeren Konstruktur zu initialisieren. Wie zum Beispiel eine BufferedStream-Klasse, die einen Datenstrom zusätzlich im Speicher puffern soll. Dieser muss man im Konstruktor ja einen UnbufferedStream übergeben, damit sie darauf aufsetzen kann.
>Kann man bei dir Methoden schreiben, die automatisch einen Per-Object-Mutex sperren?
Was genau meinst du hier? Also automatisch geht es nicht, aber du kannst natürlich ein "Mutex" in den Properties speichern und dann bei jeder Methode ein LockMutex(*self\mutex) und UnLockMutex(*self\mutex) einfügen. Den Mutex muss man bei der Methode Initalize() erzeugen und mit "Dispose()" zerstören.
Ein Mutex ist bei mir pro Objekt immer gratis dabei. Nutzt man statt dem Schlüsselwort "Method" einfach "Synchronized" und entsprechend auch "SynchronizedReturn" und "EndSynchronized", kann man nie zwei "Synchronized"-Methoden gleichzeitig aufrufen. Hat man daneben noch normale Methoden, können dieser aber trotzdem von mehreren Threads gleichzeitig verarbeitet werden.
Das ganze lehnt auch wieder an das "synchronized"-Schlüsselwort in Java an.
>Bis auf Punkt 1 geht bei mir zumindest mal alles und ich finde es sehr praktisch. :)
Da hab ich lange rumgefummelt, bis ich das hingekriegt hab.
Ich hab auch immer noch das Problem mit den vTables. Da muss man dann eben immer noch händisch ran. Das ist auch das einzige, wo bei mir bei Erstellen einer Kindklasse noch etwas zur Laufzeit geändert wird. Gibt man in der Kindklasse in der vTable zum Beispiel eine 0 statt des Pointers zur Methode ein, wird nach dem "EndClass" die 0 durch den Pointer aus der Parent-Klasse ersetzt.