OOP again? Yoo

[NicTheQuick]

Hi folks,

I've worked on a project that's been bumming around on my hard drive since mid-2015 and finally fixed the two bugs that still needed to be fixed. The last bug has been bothering me since Wednesday until I found out how to get it right.

Anyway, let's get some facts straight:
This is another OOP wrapper for Purebasic, which consists only of macros and modules and does not require any precompilers. Almost 600 lines of code offer the following possibilities:

• Interfaces with inheritance (IClass)
• Classes with inheritance (Class)
• Abstract classes with inheritance (Class, in which not all methods are defined)
• Static fields (StaticMembers)
• Fields (Members)
• Default constructor (DefaultConstructor) or private default constructor (PrivateDefaultConstructor)
• Custom constructors (Constructors and Construct)
• Deconstructor (Deconstructor)
• Calling other constructors within the same class (CallConstructor)
• Calling constructors of super classes (CallSuperConstructor)
• Methods (Method)
• Static methods (Procedure)
• Private methods (PrivateMethod)
• Synchronized methods which are locked with an object wide mutex (Synchronized)
• Default methods like free() and toString() where toString() can be overridden
• Overriding of methods
• Calling methods of the super class, even overidden ones (super(BASEKLASS)\Method())
• Access fields of the super class (superm(BASEKLASS)\feld)
• Using the interface of the class (Define obj.type(KLASS) = new(KLASS))
• Using the fields of the class (Define obj.typem(KLASS))
• Call methods within methods (self\Method())
• Use fields within methods (this\field)
• Call methods of child classes, useful when you want to call the overridden method, not your own (child\Method()) (ATTENTION!)
• Check if a method is virtual or not (callable(KLASS, Method))
• Check if an object is an instance of a given class or interface (isInstance(obj, KLASS))
• Thread safe

Hopefully all features were briefly summarized. I am very proud of the possibilities with the constructors. Basically any number of constructors can be created, in addition a class A can be created, which cannot be instantiated at all. If you try, you get a memory access violation. It is a lot of work to provide enough examples for you, but first I can provide you with my test file, which hopefully uses all the features listed above, because it is there to check the complete construct.

This is the main file:
Object.pbi

Code: Select all

;DebugLevel 10

DeclareModule ClassUtil
	EnableExplicit
	
	; ======================================= Helfer-Makros =======================================
	
	Macro __MacroColon__
		:
	EndMacro
	
	Macro __JoinMacroParts__(P1, P2=, P3=, P4=, P5=, P6=, P7=, P8=)
		P1#P2#P3#P4#P5#P6#P7#P8
	EndMacro
	
	Macro __CreateMacro__(name,macroBody)
		__JoinMacroParts__(Macro name, __MacroColon__, macroBody, __MacroColon__, EndMacro)
	EndMacro
	
	Macro __DQ__
		"
	EndMacro
	
	Macro __MakeString__(__text__)
		__DQ__#__text__#__DQ__
	EndMacro
	
	Macro __ClassId__
	  (MacroExpandedCount)
	EndMacro
	
	;Bug: https://www.purebasic.fr/english/viewtopic.php?f=23&t=63868
	;Bug was solved!
	;Prototype __default_constructor_prototype__(*super = 0)
	
	; ==================================== Klassen-Hierarchie =====================================
	
	Macro IClass(__ClassName__,BaseClassName=Object)
		DeclareModule __ClassName__
			EnableExplicit
			__CreateMacro__(__class__, __ClassName__) :
			__CreateMacro__(__base__, BaseClassName) :
			UseModule ClassUtil
			
			#__INTERFACE__ = 1
			
			Define __default_constructor__.i
			
			Declare.i __DefaultConstructor__(*super = 0, callUserConstructor.i = #True)
			
			#__STRUC_SIZE__ = BaseClassName#::#__STRUC_SIZE__
			
			Define *__pvTable__ = BaseClassName#::*__pvTable__
			Define __pvTableSize__.i = BaseClassName#::__pvTableSize__
			#__CLASS_ID__ = __ClassId__
			
			Declare.i __isInstance__(*__pDefaultConstructor__)
			
			Interface I#__ClassName__ Extends BaseClassName#::I#BaseClassName
	EndMacro
	
	Macro EndIClass
			EndInterface
			Structure __class__
			EndStructure
			Structure __class__#_Inherited Extends __base__#::__base__#_Inherited; Align #PB_Structure_AlignC
				__class__.__class__[0]
			EndStructure
		EndDeclareModule
		Module __class__
			__default_constructor__ = 0
			
			Procedure.i __DefaultConstructor__(*super = 0, callUserConstructor.i = #True)
				ProcedureReturn __base__#::__DefaultConstructor__(*super, callUserConstructor)
			EndProcedure
			
			Procedure.i __isInstance__(*__pDefaultConstructor__)
					If @__DefaultConstructor__() = *__pDefaultConstructor__
						ProcedureReturn #True
					EndIf
					CompilerIf __MakeString__(__base__) = "ClassUtil"
						ProcedureReturn #False
					CompilerElse
						ProcedureReturn __base__#::__isInstance__(*__pDefaultConstructor__)
					CompilerEndIf
			EndProcedure
		EndModule
	EndMacro
	
	Macro Class(__ClassName__,BaseClassName=Object)
		DeclareModule __ClassName__
			EnableExplicit
			__CreateMacro__(__class__, __ClassName__) :
			__CreateMacro__(__base__, BaseClassName) :
			UseModule ClassUtil
			
			; Function pointer to the default constructor. 0 if there is no default constructor or if it is private.
			Define __default_constructor__.i
			
			Declare.i __DefaultConstructor__(*super = 0, callUserConstructor.i = #True)
			Declare.i __isInstance__(*__pDefaultConstructor__)
			
			Interface I#__ClassName__ Extends BaseClassName#::I#BaseClassName
	EndMacro
	
	Macro StaticMembers
		CompilerIf Defined(__INTERFACE__, #PB_Constant)
			CompilerError "StaticMembers not allowed in IClass!"
		CompilerEndIf
		CompilerIf Not Defined(__MEMBERS__, #PB_Constant)
			EndInterface
		CompilerElse
			EndStructure
			#__MEMBERS_END_STRUCTURE__ = 1
		CompilerEndIf
		#__STATIC_MEMBERS__ = 1
	EndMacro
	
	Macro Members
			CompilerIf Defined(__INTERFACE__, #PB_Constant)
				CompilerError "Members not allowed in IClass!"
			CompilerEndIf
			CompilerIf Not Defined(__STATIC_MEMBERS__, #PB_Constant)
				EndInterface
			CompilerEndIf
			#__MEMBERS__ = 1
			Structure __class__; Align #PB_Structure_AlignC
				*vTable
				*__pBase__.__base__#::I#__base__
				*super.__class__#_Inherited
				__self__.I#__class__
	EndMacro
	
	Macro Constructors
		CompilerIf Defined(__INTERFACE__, #PB_Constant)
			CompilerError "Constructors not allowed in IClass!"
		CompilerEndIf
		CompilerIf Not Defined(__MEMBERS__, #PB_Constant)
			Members
		CompilerEndIf
		CompilerIf Not Defined(__MEMBERS_END_STRUCTURE__, #PB_Constant)
			EndStructure
		CompilerEndIf
			#__CONSTRUCTORS__ = 1
	EndMacro
	
	Macro Definition
		CompilerIf Defined(__INTERFACE__, #PB_Constant)
			CompilerError "Definition not allowed in IClass!"
		CompilerEndIf
		CompilerIf Not Defined(__CONSTRUCTORS__, #PB_Constant)
			Constructors
		CompilerEndIf
			Structure __class__#_Inherited Extends __base__#::__base__#_Inherited; Align #PB_Structure_AlignC
				__class__.__class__
			EndStructure
			; TODO BUG?
			#__STRUC_SIZE__ = SizeOf(__class__);OffsetOf(__class__#_Inherited\__class__) - OffsetOf(__class__#_Inherited\__base__)
			;Debug __MakeString__(__class__) + "::#__STRUC_SIZE__ = " + #__STRUC_SIZE__, 9
			Define *__pvTable__, __pvTableSize__.i
		EndDeclareModule
		Interface __class__ Extends __class__#::I#__class__
		EndInterface
		Module __class__
			__pvTableSize__ = SizeOf(I#__class__) / SizeOf(Integer)
			Dim __vTable__.i(__pvTableSize__)
			__vTable__(0) = @__isInstance__()
			*__pvTable__ = @__vTable__(1)
			#__DEFINITION__ = 1
			Declare.i __UserDefaultConstructor__(*__this__.__class__)
			
			Procedure.i __DefaultConstructor__(*super.__class__#_Inherited = 0, callUserConstructor.i = #True)
				Shared __vTable__()
				Debug __MakeString__(__class__) + "::DefaultConstructor Begin", 10
				If Not *super
					CompilerIf __MakeString__(__class__) = "Object"
						ProcedureReturn #False
					CompilerElse
						*super = AllocateStructure(__class__#_Inherited)
						If Not *super
							ProcedureReturn #False
						EndIf
						Debug __MakeString__(__class__) + "::DefaultConstructor AllocateStructure", 10
						If Not __base__#::__DefaultConstructor__(*super)
							Goto __error_free__
						EndIf
					CompilerEndIf
				Else
					CompilerIf __MakeString__(__class__) <> "Object"
						If Not __base__#::__DefaultConstructor__(*super)
							ProcedureReturn #False
						EndIf
					CompilerEndIf
				EndIf
		
				Protected *__this__.__class__ = @*super\__class__
				
				*__this__\vTable = @__vTable__(1)
				*__this__\super = *super
				*__this__\__self__ = @*super\__class__
				CompilerIf __MakeString__(__class__) <> "Object"
					*__this__\__pBase__ = @*super\__class__ - __base__#::#__STRUC_SIZE__ ;@*super\__base__
					Debug "============== " + __MakeString__(__class__) + " ==============", 9
					Debug "@*super\" + __MakeString__(__base__) + " = " + @*super\__base__, 9
					Debug "@*super\" + __MakeString__(__class__) + " - " + __MakeString__(__base__) + "::#__STRUC_SIZE__ = " + StrU(@*super\__class__ - __base__#::#__STRUC_SIZE__), 9
					Debug __MakeString__(__base__) + "::#__STRUC_SIZE__ = " + __base__#::#__STRUC_SIZE__, 9
				CompilerElse
					*__this__\__pBase__ = 0
				CompilerEndIf
					
				
				If callUserConstructor
					If Not __UserDefaultConstructor__(*__this__)
						CompilerIf OffsetOf(__class__#_Inherited\__class__) = 0
							FreeStructure(*__this__\super)
							Debug __MakeString__(__class__) + "::DefaultConstructor FreeStructure", 10
						CompilerElse
							*__this__\__pBase__\free()
							;super()\free()
						CompilerEndIf
						ProcedureReturn #False
					EndIf
				EndIf
				
				Debug __MakeString__(__class__) + "::DefaultConstructor End", 10
				ProcedureReturn *__this__
				
				__error_free__:
				FreeStructure(*super)
				Debug __MakeString__(__class__) + "::DefaultConstructor FreeStructure", 10
				ProcedureReturn #False
			EndProcedure
			
			Procedure.i __isInstance__(*__pDefaultConstructor__)
					If @__DefaultConstructor__() = *__pDefaultConstructor__
						ProcedureReturn #True
					EndIf
					CompilerIf __MakeString__(__base__) = "ClassUtil"
						ProcedureReturn #False
					CompilerElse
						ProcedureReturn __base__#::__isInstance__(*__pDefaultConstructor__)
					CompilerEndIf
			EndProcedure
	EndMacro
	
	Macro EndClass
		CompilerIf Defined(__INTERFACE__, #PB_Constant)
			CompilerError "EndClass not allowed in IClass!"
		CompilerEndIf
		CompilerIf Not Defined(__DEFINITION__, #PB_Constant)
			Definition
		CompilerEndIf
			; Wurde kein Destructor erstellt, erstelle selbst einen
			CompilerIf Not Defined(__DECONSTRUCTOR__, #PB_Constant)
				Deconstructor
				EndDeconstructor
			CompilerEndIf
			; Wurde kein Default Constructor erstellt, erstelle selbst einen, aber mache ihn nicht für new zugänglich.
			CompilerIf Not Defined(__DEFAULT_CONSTRUCTOR__, #PB_Constant)
				DefaultConstructor
				EndDefaultConstructor
				__default_constructor__ = 0
			CompilerEndIf
			CompilerIf Not Defined(toString, #PB_Procedure)
				Procedure.s toString(*__this__.__class__)
					ProcedureReturn "<" + __MakeString__(__class__) + " @" + Hex(*__this__, #PB_Quad) + ">"
				EndProcedure
			CompilerEndIf
			__vTable__(1) = @free()
			Debug __MakeString__(__class__) + "::free() @ " + @free(), 9
			__vTable__(2) = @toString()

			CompilerIf __MakeString__(__base__) <> "ClassUtil"
				Define __i__.i
				For __i__ = 0 To __base__#::__pvTableSize__ - 1
					If __vTable__(__i__ + 1) = 0
						__vTable__(__i__ + 1) =  PeekI(__base__#::*__pvTable__ + __i__ * SizeOf(Integer))
					EndIf
				Next
			CompilerEndIf
			UndefineMacro __class__
			UndefineMacro __base__
		EndModule
	EndMacro
	
	; ============================== Basis-Interface und -Strukturen ==============================
	
	Interface IClassUtil
	EndInterface
	
	Structure ClassUtil
		*vTable
		*__pBase__
		*super
		__self__.IClassUtil
	EndStructure
	Structure ClassUtil_Inherited
		ClassUtil.i[0]
	EndStructure

	; ================================= Standard (De)Constructor ==================================
	
	Macro DefaultConstructor
		CompilerIf Defined(__DEFAULT_CONSTRUCTOR__, #PB_Constant)
			CompilerError "Default constructor already declared."
		CompilerEndIf
		#__DEFAULT_CONSTRUCTOR__ = 1
		Procedure.i __UserDefaultConstructor__(*__this__.__class__)
			Debug __MakeString__(__class__) + "::UserDefaultConstructor Begin", 10
			Protected __self__.I#__class__ = *__this__
	EndMacro
	
	Macro PrivateDefaultConstructor
		#__PRIVATE_DEFAULT_CONSTRUCTOR__ = 1
		DefaultConstructor
	EndMacro
	
	Macro EndDefaultConstructor
			Debug __MakeString__(__class__) + "::UserDefaultConstructor End", 10
			ProcedureReturn *__this__
		EndProcedure
		CompilerIf Not Defined(__DEFAULT_CONSTRUCTOR__, #PB_Constant)
			CompilerError "EndDefaultConstructor without DefaultConstructor."
		CompilerEndIf
		CompilerIf Defined(__PRIVATE_DEFAULT_CONSTRUCTOR__, #PB_Constant)
			__default_constructor__ = 0
		CompilerElse
			__default_constructor__ = @__DefaultConstructor__()
		CompilerEndIf
	EndMacro
	
	Macro Deconstructor
		CompilerIf Defined(__DECONSTRUCTOR__, #PB_Constant)
			CompilerError "Deconstructor already declared."
		CompilerEndIf
		#__DECONSTRUCTOR__ = 1
		Procedure.i free(*__this__.__class__)
			Debug __MakeString__(__class__) + "::Deconstructor Begin", 10
			Protected __self__.I#__class__ = *__this__
			Debug __MakeString__(__class__) + "::Deconstructor", 9
	EndMacro
	
	Macro EndDeconstructor
			CompilerIf OffsetOf(__class__#_Inherited\__class__) = 0
				FreeStructure(*__this__\super)
				Debug __MakeString__(__class__) + "::DefaultConstructor FreeStructure", 10
			CompilerElse
				Debug "*__this__ = " + *__this__, 9
				Debug "*__this__\__pBase__  = " + *__this__\__pBase__, 9
				Debug "*__this__\__pBase__\vTable = " + PeekI(*__this__\__pBase__), 9
				Debug "@" + __MakeString__(__base__) + "::free() = " + PeekI(PeekI(*__this__\__pBase__)), 9
				
				*__this__\__pBase__\free()
			CompilerEndIf
			Debug __MakeString__(__class__) + "::Deconstructor End", 10
		EndProcedure
		CompilerIf Not Defined(__DECONSTRUCTOR__, #PB_Constant)
			CompilerError "EndDeconstructor without Deconstructor."
		CompilerEndIf
	EndMacro
	
	Macro ConstructorFailure
		Debug __MakeString__(__class__) + "::ConstructorFailure", 10
		CompilerIf #PB_Compiler_Procedure <> "__UserDefaultConstructor__"
			*__this__\__pBase__\free()
		CompilerEndIf
		ProcedureReturn 0
	EndMacro
	
	Macro CallConstructor(__ConstructorName__=,__ParameterList__=())
		CompilerIf __MakeString__(__ConstructorName__) = ""
			If Not __UserDefaultConstructor__(*__this__) : ConstructorFailure :	EndIf
		CompilerElse
			__ConstructorName__#_this = *__this__
			If Not __ConstructorName__#__ParameterList__
				__ConstructorName__#_this = 0
				ProcedureReturn 0
			Else
				__ConstructorName__#_this = 0
			EndIf
		CompilerEndIf
	EndMacro
	
	Macro CallSuperConstructor(__subclass__, __ConstructorName__,__ParameterList__=())
		CompilerIf __MakeString__(__ConstructorName__) = ""
			CompilerError "Can not call DefaultConstructor of class '" + _MakeString__(__subclass__) + "', because it was already called."
		CompilerElse
			__subclass__#::__ConstructorName__#_this = @*__this__\super\__subclass__
			If Not __subclass__#::__ConstructorName__#__ParameterList__
				__subclass__#::__ConstructorName__#_this = 0
				ProcedureReturn 0
			Else
				__subclass__#::__ConstructorName__#_this = 0
			EndIf
		CompilerEndIf
	EndMacro
	
	Macro Construct(__ConstructorName__,__ParamaterList__)
		CompilerIf Not Defined(__CONSTRUCTORS__, #PB_Constant)
			CompilerError "Construct without ClassConstructors"
		CompilerEndIf
		Threaded __ConstructorName__#_this.i
		Declare.i __ConstructorName__#__ParamaterList__
	EndMacro
	
	Macro Constructor(__ConstructorName__,__ParamaterList__=())
		CompilerIf Not Defined(__CONSTRUCTORS__, #PB_Constant)
			CompilerError "Constructor without ClassConstructors"
		CompilerEndIf
		#__CONSTRUCTOR_#MacroExpandedCount#__ = 1
		Procedure.i __ConstructorName__#__ParamaterList__
			Debug __MakeString__(__class__) + "::Constructor " + #PB_Compiler_Procedure + " Begin", 10
			Protected *__this__.__class__
			If __ConstructorName__#_this
				*__this__ = __ConstructorName__#_this
			Else
				*__this__ = __DefaultConstructor__(0, #False)
			EndIf
			Protected __self__.I#__class__ = *__this__
	EndMacro
	
	Macro EndConstructor
		CompilerIf Not Defined(__CONSTRUCTOR_#MacroExpandedCount#__, #PB_Constant)
			CompilerError "EndConstructor without Constructor"
		CompilerEndIf
			Debug __MakeString__(__class__) + "::Constructor " + #PB_Compiler_Procedure + " End", 10
			ProcedureReturn *__this__
		EndProcedure
	EndMacro
	
	; ====================================== Zugriffs-Helfer ======================================
	
	Declare.i __firstIsInstance__(*__this__.ClassUtil, *__pDefaultConstructor__)
	
	; Gibt das Interface zum Klassennamen zurück
	Macro type(__ClassName__) :
		__ClassName__#::I#__ClassName__
	EndMacro
	
	; Gibt die Struktur zum Klassennamen zurück
	Macro typem(__ClassName__)
		__ClassName__#::__ClassName__
	EndMacro
	
	; Ruft den Standard Konstruktur einer Klasse auf
	Macro new(__ClassName__)
		CallFunctionFast(__ClassName__#::__default_constructor__, 0, #True)
	EndMacro
	
	; Gibt Zugriff auf die Methoden einer bestimmten Unterklasse oder der eigenen Klasse.
	Macro super(BaseClass=__base__,__this__=this)
		__this__\super\BaseClass\__self__
	EndMacro
	
	; Gibt Zugriff auf die Strukturfelder einer bestimmten Unterklasse oder der eigenen Klasse.
	Macro superm(BaseClass=__base__,__this__=this)
		__this__\super\BaseClass
	EndMacro
	
	; Ruft die Methoden der aktuellen Instanz auf. Das müssen nicht die eigenen sein, sondern können auch überschriebene sein.
	Macro self
		__self__
	EndMacro
	
	; Gibt Zugriff auf die Strukturfelder der eigenen Klasse.
	Macro this
		*__this__.__class__
	EndMacro
	
	; Ruft die Methoden der direkten Unterklasse auf oder provoziert einen Ungültigen Speicherzugriff, wenn keine existiert und instantiiert wurde.
	Macro child
		__child__
	EndMacro
	
	; Gibt den Pointer zu einer bestimmten Methode einer Klasse zurück. Ist dieser 0, ist die Methode virtuell.
	Macro callable(__ClassName__,__MethodName__)
		Bool((OffsetOf(__ClassName__#::I#__ClassName__\__MethodName__()) / SizeOf(Integer) < __ClassName__#::__pvTableSize__) And PeekI(__ClassName__#::*__pvTable__ + OffsetOf(__ClassName__#::I#__ClassName__\__MethodName__())))
	EndMacro
	
	; Gibt #True zurück, wenn das übergebene Objekt einer Instanz der angegebenen Klasse oder einer Kindklasse ist.
	Macro isInstance(__Object__,__ClassName__)
		(ClassUtil::__firstIsInstance__(__Object__, __ClassName__#::@__DefaultConstructor__()))
	EndMacro
	
	;???
	Macro restrictedCast(__varName__, __object__, __ClassName__)
		*__varName__.__ClassName__#::__ClassName__ = __object__
	EndMacro
	
	; ========================================= Methoden ==========================================
	
	Macro Method(__P1__,__P2__,__P3__=)
		CompilerIf __MakeString__(__P3__) = ""
			Declare __P1__#__P2__
			__vTable__(OffsetOf(I#__class__\__P1__()) / SizeOf(Integer) + 1) = @__P1__()
			Procedure __P1__#__P2__
				Protected __result__.i = 0
				Debug __MakeString__(__class__) + "::" + __MakeString__(__P1__#__P2__) + " Begin", 10
		CompilerElse
			Declare.__P1__ __P2__#__P3__
			__vTable__(OffsetOf(I#__class__\__P2__()) / SizeOf(Integer) + 1) = @__P2__()
			Procedure.__P1__ __P2__#__P3__
				Protected __result__.__P1__ 
				Debug __MakeString__(__class__) + "::" + __MakeString__(__P2__#__P3__) + " Begin", 10
		CompilerEndIf
		CompilerIf Not Defined(*__this__, #PB_Variable)
			CompilerError "Parameter 'this' is missing in Method's parameter list."
		CompilerEndIf
		Protected __self__.I#__class__ = *__this__
		*__this__ = *__this__\super\__class__\__self__
		Protected __child__.I#__class__ = *__this__ + SizeOf(__class__)
	EndMacro
	
	Macro PrivateMethod(__P1__,__P2__,__P3__=)
		CompilerIf __MakeString__(__P3__) = ""
			Procedure __P1__#__P2__
				;Protected __result__.i = 0
				Debug __MakeString__(__class__) + "::" + __MakeString__(__P1__#__P2__) + " Begin", 10
		CompilerElse
			Procedure.__P1__ __P2__#__P3__
				;Protected __result__.__P1__ 
				Debug __MakeString__(__class__) + "::" + __MakeString__(__P2__#__P3__) + " Begin", 10
		CompilerEndIf
		CompilerIf Not Defined(*__this__, #PB_Variable)
			CompilerError "Parameter 'this' is missing in Method's parameter list."
		CompilerEndIf
		Protected __self__.I#__class__ = *__this__
		*__this__ = *__this__\super\__class__\__self__
		Protected __child__.I#__class__ = *__this__ + SizeOf(__class__)
	EndMacro
	
	Macro Synchronized(__P1__,__P2__,__P3__=)
		Method(__P1__,__P2__,__P3__)
		LockMutex(*__this__\super\Object\__objectLock)
	EndMacro
	
	Macro EndMethod
			Debug "EndMethod", 10
			;__method_end__:
			;ProcedureReturn __result__
		EndProcedure
	EndMacro
	
	Macro EndSynchronized
			;__method_end__:
			UnlockMutex(*__this__\super\Object\__objectLock)
			Debug "EndSynchronized", 10
			;ProcedureReturn __result__
		EndProcedure
	EndMacro
	
	Macro MethodReturn(__RETURN__)
		;__result__ = __RETURN__
		;Goto __method_end__
		Debug "MethodReturn", 10
		ProcedureReturn __RETURN__
	EndMacro
	
	Macro SynchronizedReturn(__RETURN__)
		;__result__ = __RETURN__
		;Goto __method_end__
		UnlockMutex(*__this__\super\Object\__objectLock)
		Debug "SynchronizedReturn", 10
		ProcedureReturn __RETURN__
	EndMacro
EndDeclareModule
Module ClassUtil
	Procedure.i __firstIsInstance__(*__this__.ClassUtil, *__pDefaultConstructor__)
		If Not *__this__
			ProcedureReturn #False
		EndIf
		
		ProcedureReturn CallFunctionFast(PeekI(*__this__\vTable - SizeOf(Integer)), *__pDefaultConstructor__)
	EndProcedure
EndModule

UseModule ClassUtil

Class(Object, ClassUtil)
	free.i()
	toString.s()
	Members
		__objectLock.i
	Definition
		PrivateDefaultConstructor
			this\__objectLock = CreateMutex()
		EndDefaultConstructor
		
		Deconstructor
			FreeMutex(this\__objectLock)
		EndDeconstructor
EndClass

The following articles will finally give some examples, which I will deliver later.

Mostly translated with http://www.DeepL.com/Translator

[NicTheQuick]

CLASS_TEST.pb

Code: Select all

XIncludeFile "Object.pbi"

Macro T(number)
	#TEST#number = #True
EndMacro

T(1)	; Empty class
T(2)	; Normal members
T(3)	; Static Members
T(4)	; Normal and static members
T(5)	; Normal and static members and static procedures
T(6)	; Different arrangements of keywords within a class declaration
T(11)	; User defined constructor, members and methods
T(12)	; User defined constructor called by default constructor
T(13)	; Constructure failures in different ways and recursions
T(14)	; Test if a non existent default constructor is not callable
T(15)	; Test if a private default constructor is not callable
T(16)	; Test if a private default constructor does initialize member variables correctly, test if super() and self call the correct methods, test overriding methods
T(17)	; Test toString() method and isInstance()
T(18)	; Test completely virtual classes and multiple inheritance with isInstance() und callable()
T(19)	; Test if Deconstructor can succesfully call other methods
T(20)	; Test CallSuperConstructor()

Macro DQ
	"
EndMacro

Macro ASSERT(a, b, e="")
	If (a <> b)
		Debug "ASSERT Error: " + e
	EndIf
EndMacro
Macro ASSERT_NOT(a, b, e="")
	If (a = b)
		Debug "Assert Error: " + e
	EndIf
EndMacro

;- TEST 01
CompilerIf Defined(TEST1, #PB_Constant)
	Debug "Test 01"

	; Test empty class
	Class(test1)
	EndClass

CompilerEndIf

;- TEST 02
CompilerIf Defined(TEST2, #PB_Constant)
	Debug "Test 02"

	; Test class with members
	Class(test2)
		Members
			a.i
	EndClass

CompilerEndIf

;- TEST 03
CompilerIf Defined(TEST3, #PB_Constant)
	Debug "Test 03"

	; Test class with static members
	Class(test3)
		StaticMembers
			Define version.d = 3.00
	EndClass
	ASSERT(test3::version, 3.00, "Wrong version!")

CompilerEndIf

;- TEST 04
CompilerIf Defined(TEST4, #PB_Constant)
	Debug "Test 04"
	
	; Test class with members and static members
	Class(test4)
		Members
			a.i
		StaticMembers
			Define version.d = 4.00
	EndClass
	ASSERT(test4::version, 4.00, "Wrong version!")

CompilerEndIf

;- TEST 05
CompilerIf Defined(TEST5, #PB_Constant)
	Debug "Test 05"
	
	; Test class with members, static members and static procedures
	Class(test5)
		StaticMembers
			Declare.d version()
		Members
			a.i
		Definition
			Procedure.d version()
				ProcedureReturn 5.00
			EndProcedure
	EndClass
	ASSERT(test5::version(), 5.00, "Wrong version!")
	
CompilerEndIf

;- TEST 06
CompilerIf Defined(TEST6, #PB_Constant)
	Debug "Test 06"

	; Test different kinds of arrangements of keywords within a class declaration
	Class(test6a)
		Constructors
	EndClass
	Class(test6b)
		StaticMembers
		Members
		Constructors
	EndClass
	Class(test6c)
		Members
		StaticMembers
		Constructors
	EndClass
	Class(test6d)
		Members
		Constructors
	EndClass
	Class(test6e)
		StaticMembers
		Constructors
	EndClass

CompilerEndIf

;- TEST 11
CompilerIf Defined(TEST11, #PB_Constant)
	Debug "Test 11"

	; Test class with user defined constructor
	Class(test11)
		getA.i()
		Members
			a.i
		Constructors
			Construct(setA,(a.i))
		Definition
			Constructor(setA,(a.i))
				this\a = a
			EndConstructor
			
			Method(i,getA,(this))
				MethodReturn(this\a)
			EndMethod
	EndClass
	Define test11.type(test11) = test11::setA(123)
	ASSERT_NOT(test11, 0, "test11::setA(123) not correctly initialized!")
	ASSERT(test11\getA(), 123, "test11::getA() returns wrong number!")
	test11\free()

CompilerEndIf

;- TEST 12
CompilerIf Defined(TEST12, #PB_Constant)
	Debug "Test 12"

	; Test class with user defined constructor called by the default constructor
	Class(test12)
		getA.i()
		Members
			a.i
		Constructors
			Construct(setA,(a.i))
		Definition
			DefaultConstructor
				; call other constructor within default constructor.
				CallConstructor(setA,(5))
			EndDefaultConstructor
			
			Constructor(setA,(a.i))
				this\a = a
			EndConstructor
			
			Method(i,getA,(this))
				MethodReturn(this\a)
			EndMethod
	EndClass
	Define test12.type(test12) = new(test12)
	ASSERT_NOT(test12, 0, "new(test12) not correctly initialized!")
	ASSERT(test12\getA(), 5, "test12\getA() returned wrong number!")
	test12\free()

CompilerEndIf

;- TEST 13
CompilerIf Defined(TEST13, #PB_Constant)
	Debug "Test 13"

	; Test constructure failures in different ways and recursions
	Class(test13)
		Constructors
			Construct(Fail1,(a.i))
			Construct(Fail2,(a.i))
			Construct(Fail3,(a.i))
			Construct(Fail4,(a.i))
		Definition
			DefaultConstructor
				ConstructorFailure
			EndDefaultConstructor
			
			Constructor(Fail1,(a.i))
				ConstructorFailure
			EndConstructor
			
			Constructor(Fail2,(a.i))
				CallConstructor()
			EndConstructor
			
			Constructor(Fail3,(a.i))
				CallConstructor(Fail1,(a))
			EndConstructor
			
			Constructor(Fail4,(a.i))
				CallConstructor(Fail2,(a))
			EndConstructor
	EndClass
	
	ASSERT(new(test13), 0, "new(test13) should be 0!")
	ASSERT(test13::Fail1(1), 0, "test13::Fail1(1) should be 0!")
	ASSERT(test13::Fail2(1), 0, "test13::Fail2(1) should be 0!")
	ASSERT(test13::Fail3(1), 0, "test13::Fail3(1) should be 0!")
	ASSERT(test13::Fail4(1), 0, "test13::Fail4(1) should be 0!")

CompilerEndIf

;- TEST 14
CompilerIf Defined(TEST14, #PB_Constant)
	Debug "Test 14"

	; Test if a non existent default constructor is not callable.
	Class(test14)
	EndClass
	
	ASSERT(test14::__default_constructor__, 0, "new(test14) should fail!")

CompilerEndIf

;- TEST 15
CompilerIf Defined(TEST15, #PB_Constant)
	Debug "Test 15"
	
	; Test if a private default constructor is not callable.
	Class(test15)
		Definition
			PrivateDefaultConstructor
			EndDefaultConstructor
	EndClass

	ASSERT(test15::__default_constructor__, 0, "new(test15) should fail!")

CompilerEndIf

;- TEST 16
CompilerIf Defined(TEST16, #PB_Constant)
	Debug "Test 16"

	; Test if a private default constructor does initialize member variables correctly.
	Class(test16a)
		get1.i()
		get2.i()
		Members
			a.i
		Definition
			; Make Default Constructor invisible
			PrivateDefaultConstructor
				this\a = 100
			EndDefaultConstructor
			
			Method(i,get1,(this))
				MethodReturn(this\a)
			EndMethod
	EndClass
	ASSERT_NOT(callable(test16a,get1),0,"test16a\get1() should be callable!")
	ASSERT(callable(test16a,get2),0,"test16a\get2() should not be callable!")
	
	; Test if super() and self call the correct methods.
	Class(test16b,test16a)
		get103.i()
		Definition
			; Make Default Constructor visible
			DefaultConstructor
			EndDefaultConstructor
			
			; Override get1()
			Method(i,get1,(this))
				MethodReturn(1)
			EndMethod
			
			;Implement get2()
			Method(i,get2,(this))
				MethodReturn(self\get1() + 1)
			EndMethod
			
			;Use get1() from this class and from base class
			Method(i,get103,(this))
				MethodReturn(super()\get1() + self\get1() + self\get2())
			EndMethod
	EndClass
	
	Define test16b.type(test16b) = new(test16b)
	ASSERT(test16b\get1(), 1, "test16b\get1() should return 100.")
	ASSERT(test16b\get2(), 2, "test16b\get2() should return 2.")
	ASSERT(test16b\get103(), 103, "test16b\get3() should return 3.")
	test16b\free()

CompilerEndIf

;- TEST 17
CompilerIf Defined(TEST17, #PB_Constant)
	Debug "Test 17"

	; Test the toString method and isInstance
	Class(test17a)
		Definition
			DefaultConstructor
			EndDefaultConstructor
			
			Method(s,toString,(this))
				MethodReturn("test17a")
			EndMethod
	EndClass
	Class(test17b, test17a)
		Definition
			DefaultConstructor
			EndDefaultConstructor
			
			Method(s,toString,(this))
				MethodReturn(super(test17a)\toString() + "->test17b")
			EndMethod
	EndClass
	
	Define test17a.type(test17a) = new(test17a)
	Define test17b.type(test17b) = new(test17b)
	ASSERT(isInstance(test17b,test17b), #True, "isinstance(test17b,test17b) should be true")
	ASSERT(isInstance(test17b,test17a), #True, "isinstance(test17b,test17a) should be true")
	ASSERT(isInstance(test17b,Object), #True, "isinstance(test17b,Object) should be true")
	ASSERT(isInstance(test17a,test17b), #False, "isinstance(test17a,test17b) should be false")
	ASSERT(isInstance(test17a,test17a), #True, "isinstance(test17a,test17a) should be true")
	ASSERT(isInstance(test17a,Object), #True, "isinstance(test17a,Object) should be true")
	ASSERT(test17a\toString(), "test17a", "test17a\toString() should return 'test17a'")
	ASSERT(test17b\toString(), "test17a->test17b", "test17b\toString() should return 'test17a->test17b'")

CompilerEndIf

;- TEST 18
CompilerIf Defined(TEST18, #PB_Constant)
	Debug "Test 18"

	; Test completely virtual classes and multiple inheritance
	IClass(test18a)
		method1.i()
	EndIClass
	
	IClass(test18b, test18a)
		method2.i()
	EndIClass
	
	Class(test18c, test18b)
			method3.i()
		Definition
			DefaultConstructor
			EndDefaultConstructor
			
			Method(i, method3, (this))
			EndMethod
	EndClass
	
	IClass(test18d, test18a)
	EndIClass
	
	IClass(test18e, test18a)
		method2b.i()
	EndIClass
	
	Class(test18f, test18d)
	EndClass
	
	Define test18c.type(test18c) = new(test18c)
	ASSERT(callable(test18a, method1), #False, "callable(test18a, method1) should be false.")
	ASSERT(callable(test18b, method1), #False, "callable(test18b, method1) should be false.")
	ASSERT(callable(test18b, method2), #False, "callable(test18b, method2) should be false.")
	ASSERT(callable(test18c, method1), #False, "callable(test18c, method1) should be false.")
	ASSERT(callable(test18c, method2), #False, "callable(test18c, method2) should be false.")
	ASSERT(callable(test18c, method3), #True,  "callable(test18c, method3) should be true.")
	ASSERT(isInstance(test18c, test18c), #True, "isInstance(test18c, test18c) should be true.")
	ASSERT(isInstance(test18c, test18b), #True, "isInstance(test18c, test18b) should be true.")
	ASSERT(isInstance(test18c, test18a), #True, "isInstance(test18c, test18a) should be true.")
	ASSERT(isInstance(test18c, test18d), #False, "isInstance(test18c, test18d) should be false, but is okay because there are no more methods.")
	ASSERT(isInstance(test18c, test18e), #False, "isInstance(test18c, test18e) should be false.")
	ASSERT(isInstance(test18c, test18f), #False, "isInstance(test18c, test18f) should be false.")
	
	test18c\free()

CompilerEndIf

;- TEST 19
CompilerIf Defined(TEST19, #PB_Constant)
	Debug "Test 19"

	; Test that Deconstructor can succesfully call other methods
	Class(test19)
			incI()
		Members
			*i.Integer
		Constructors
			Construct(test, (*i))
		Definition
			Constructor(test, (*i))
				this\i = *i
			EndConstructor
			
			Deconstructor
				this\i\i = 1
				self\incI()
			EndDeconstructor
			
			Method(incI, (this))
				this\i\i + 2
			EndMethod
	EndClass
	
	Define i.i = 0
	Define test19.type(test19) = test19::test(@i)
	test19\incI()
	test19\free()
	ASSERT(i, 3, "i should be 3")

CompilerEndIf

;- TEST 20
CompilerIf Defined(TEST20, #PB_Constant)
	Debug "Test 20"

	Class(test20a)
		Members
			i.i
		Constructors
			Construct(set, (i.i))
		Definition
			Constructor(set, (i.i))
				this\i = i
			EndConstructor
	EndClass
	
	Class(test20b, test20a)
		get.i()
		Constructors
			Construct(set, (i.i))
		Definition
			DefaultConstructor
				CallSuperConstructor(test20a, set, (1))
			EndDefaultConstructor
			
			Constructor(set, (i.i))
				CallSuperConstructor(test20a, set, (-i))
			EndConstructor
			
			Method(i, get, (this))
				MethodReturn(superm()\i)
			EndMethod
	EndClass
	
	Define test20b.type(test20b) = new(test20b)
	ASSERT(test20b\get(), 1, "get() should return 1")
	test20b\free()
	test20b = test20b::set(2)
	ASSERT(test20b\get(), -2, "get() should return -2")
	test20b\free()

CompilerEndIf

[NicTheQuick]

A monitor class and a thread class with a runnable example. If you want to use threads more easily...
Monitor.pbi

Code: Select all

XIncludeFile "Object.pbi"

CompilerIf #PB_Compiler_OS = #PB_OS_Linux

	Class(Monitor)
		wait.i()
		signal.i()
		signalAll.i()
		lock()
		unlock()
		StaticMembers
			; See: /usr/include/x86_64-linux-gnu/bits/pthreadtypes.h
			#__SIZEOF_PTHREAD_COND_T = 48
		
			Structure pthread_cond_t__data
				__lock.l
				__futex.l
				__total_seq.q
				__wakeup_seq.q
				__woken_seq.q
				*__mutex
				__nwaiters.l
				__broadcast_seq.l
			EndStructure
			
			Structure pthread_cond_t
				StructureUnion
					__data.pthread_cond_t__data
					__size.a[#__SIZEOF_PTHREAD_COND_T]
					__align.q
				EndStructureUnion
			EndStructure
			
		Members
			cond.pthread_cond_t
		Definition
			ImportC ""
				pthread_cond_signal(*cond)
			EndImport
			
			DefaultConstructor
				If pthread_cond_init_(@this\cond, 0)
					ConstructorFailure
				EndIf
			EndDefaultConstructor
			
			Deconstructor
				LockMutex(superm(Object)\__objectLock)
				pthread_cond_broadcast_(@this\cond)
				UnlockMutex(superm(Object)\__objectLock)
				pthread_cond_destroy_(@this\cond)
			EndDeconstructor
			
			Method(wait,(this))
				pthread_cond_wait_(@this\cond, superm(Object)\__objectLock)
			EndMethod
			
			Method(signal,(this))
				pthread_cond_signal(@this\cond)
			EndMethod
			
			Method(signalAll,(this))
				pthread_cond_broadcast_(@this\cond)
			EndMethod
			
			Method(lock,(this))
				LockMutex(superm(Object)\__objectLock)
			EndMethod
			
			Method(unlock,(this))
				UnlockMutex(superm(Object)\__objectLock)
			EndMethod
	EndClass

CompilerElse

	Class(Monitor)
		wait()
		signal()
		signalAll()
		lock()
		unlock()
		Members
			s.i
			x.i
			h.i
			waiters.i
		Definition
			DefaultConstructor
				this\s = CreateSemaphore()
		 		this\x = CreateMutex()
		 		this\h = CreateSemaphore()
		 		this\waiters = 0
			EndDefaultConstructor
			
			Deconstructor
				FreeSemaphore(this\s)
				FreeSemaphore(this\h)
				FreeMutex(this\x)
			EndDeconstructor
			
			Method(wait,(this))
				LockMutex(this\x)
				this\waiters + 1
				UnlockMutex(this\x)
				UnlockMutex(superm(Object)\__objectLock)
				
				WaitSemaphore(this\s)
				SignalSemaphore(this\h)
				LockMutex(superm(Object)\__objectLock)
			EndMethod
			
			Method(signal,(this))
				LockMutex(this\x)
				If (this\waiters)
					this\waiters - 1
					SignalSemaphore(this\s)
					WaitSemaphore(this\h)
				EndIf
				UnlockMutex(this\x)
			EndMethod
			
			Method(signalAll,(this))
				Protected i.i
				
				LockMutex(this\x)
				For i = 1 To this\waiters
					SignalSemaphore(this\s)
				Next
				While this\waiters
					this\waiters - 1
					WaitSemaphore(this\h)
				Wend
				UnlockMutex(this\x)
			EndMethod
			
			Method(lock,(this))
				LockMutex(superm(Object)\__objectLock)
			EndMethod
			
			Method(unlock,(this))
				UnlockMutex(superm(Object)\__objectLock)
			EndMethod
	EndClass
	
CompilerEndIf

Thread.pbi

Code: Select all

XIncludeFile "Monitor.pbi"

Class(Thread,Monitor)
	pause.i()
	isPaused.i()
	resume.i()
	join.i()
	isRunning.i()
	start()
	run()
	Members
		thread.i
		paused.i
		joinResult.i
		*callback
		value.i
	Constructors
		Construct(Callback, (*callback, value.i))
	Definition
		PrivateDefaultConstructor
			this\callback = 0
			this\joinResult = 0
			this\thread = 0
			this\paused = 0
		EndDefaultConstructor
		
		Constructor(Callback, (*callback, value.i))
			CallConstructor()
			this\callback = *callback
			this\value = value
		EndConstructor
		
		Deconstructor
			If IsThread(this\thread)
				KillThread(this\thread)
			EndIf
		EndDeconstructor
		
		Synchronized(pause,(this))
			If Not this\paused
				this\paused = #True
				PauseThread(this\thread)
			EndIf
			SynchronizedReturn(#True)
		EndSynchronized
		
		Synchronized(isPaused,(this))
			SynchronizedReturn(this\paused)
		EndSynchronized
		
		Synchronized(resume,(this))
			If this\paused
				ResumeThread(this\thread)
				this\paused = #False
			EndIf
		EndSynchronized
		
		Synchronized(isRunning,(this))
			SynchronizedReturn(IsThread(this\thread))
		EndSynchronized
		
		Synchronized(join,(this))
			If self\isRunning()
				WaitThread(this\thread)
			EndIf
			SynchronizedReturn(this\joinResult)
		EndSynchronized
		
		Method(run,(this))
			If this\callback
				this\joinResult = CallFunctionFast(this\callback, this\value)
			Else
				this\joinResult = self\run()
			EndIf
		EndMethod
		
		Synchronized(start,(this))
			If IsThread(this\thread)
				SynchronizedReturn(#False)
			EndIf
			this\thread = CreateThread(@run(), self)
			SynchronizedReturn(this\thread)
		EndSynchronized
EndClass

CompilerIf #PB_Compiler_IsMainFile

	#threads = 5
	
	Class(Pusher, Thread)
		Members
			number.i
		Constructors
			Construct(init,(i.i))
		Definition
			Constructor(init, (i.i))
				this\number = i
			EndConstructor
			
			Method(run,(this))
				Debug "Thread " + this\number + " started."
				Debug "Waiting for " + Str(this\number * 100) + " milliseconds..."
				Delay(this\number * 100)
				Debug "Thread " + this\number + " done!"
				MethodReturn(this\number)
			EndMethod
	EndClass
	
	Dim threads.type(Pusher)(#threads - 1)
	Define i.i
	
	; Erstelle Thread-Objekte
	For i = 0 To #threads - 1
		threads(i) = Pusher::init(i + 1)
	Next
	
	; Starte alle Threads
	For i = 0 To #threads - 1
		threads(i)\start()
	Next
	
	; Warte auf Beendigung der Threads
	For i = 0 To #threads - 1
		Debug "Thread " + threads(i)\join() + " joined."
	Next
	
	; Gib alle Threads wieder frei
	For i = 0 To #threads - 1
		threads(i)\free()
	Next
	
CompilerEndIf

[idle]

looks good, thanks for sharing it.

[Kwai chang caine]

Works without error here, thanks

Test 01
Test 02
Test 03
Test 04
Test 05
Test 06
Test 11
Test 12
Test 13
Test 14
Test 15
Test 16
Test 17
Test 18
Test 19
Test 20

[NicTheQuick]

It would be nasty if you got an error and I don't. Then there would something be wrong in the purebasic compiler.

I've developed many more classes using my OOP mechanism but I first want to share it with you if I think it is complete.
At the moment there are the following classes and interfaces available. I did not explain all of these. But maybe this will give you an idea of what is already possible.

• Object
  • Condition (implementation of a condition Variable)
  • Lock (just a Mutex)
  • Monitor (a monitor class)
    • Thread (Threads like there are in Java)
    • Queue (a thread safe queue)
    • InputStream (like the InputStream in Java)
      • LoopInputStream
      • MemoryInputStream (uses or copies a block of memory and turns it into a InputStream)
      • FileInputStream (opens a file or uses a file id and turns it into a InputStream)
      • FilterInputStream ()
        • UTF8ConverterStream (converts an Purebasic character stream into a valid UTF8 character InputStream)
        • TokenizerInputStream (splits a data stream into tokens using user defined delimiters)
        • CheckedInputStream
  • IIOStream
    • ILoopIOStream
      • InifiniteLoopIOStream
      • BufferedLoopIOStream
    • Socket
    • ServerSocketClient
  • IServerSocket
    • ServerSocket
  • OutputStream
    • MemoryOutputStream
    • LoopOutputStream
    • SocketClientOutputStream

[jack]

thanks for sharing