FreeBASIC ProPgOperatorOverloading

Type UDT
    Declare Constructor ()
    Declare Destructor ()
    Dim As String s = "object #0"
End Type

Constructor UDT ()
    Print "  UDT construction "; @This
End Constructor

Destructor UDT ()
    Print "  UDT destruction "; @This
End Destructor

Type SmartPointer
    Public:
        Declare Constructor ()                            '' to construct smart pointer (and UDT object)
        Declare Constructor (ByRef rhs As SmartPointer)   '' to copy construct smart pointer
        Declare Operator Cast () As UDT Ptr               '' to cast private UDT pointer (for read only)
        Declare Destructor ()                             '' to destroy smart pointer (and UDT object)
    Private:
        Dim As UDT Ptr p                                  '' private UDT pointer
        Declare Operator Let (ByRef rhs As SmartPointer)  '' to disallow assignment (to avoid copy of real pointers)
End Type

Constructor SmartPointer ()
    Print "SmartPointer construction "; @This
    This.p = New UDT
End Constructor

Constructor SmartPointer (ByRef rhs As SmartPointer)
    Print "SmartPointer copy-construction "; @This; " from "; @rhs
    This.p = New UDT
    *This.p = *rhs.p
End Constructor

Operator SmartPointer.Cast () As UDT Ptr
    Return This.p
End Operator

Destructor SmartPointer ()
    Print "SmartPointer destruction "; @This
    Delete This.p
End Destructor

Operator * (ByRef sp As SmartPointer) ByRef As UDT   '' overloaded operator '*'
    Print "SmartPointer operator '*'"
    Return *Cast(UDT Ptr, sp)                        ''    (returning byref)
End Operator                                         ''    to behave as pointer
 
Operator -> (ByRef sp As SmartPointer) ByRef As UDT  '' overloaded operator '->'
    Print "SmartPointer operator '->'"
    Return *Cast(UDT Ptr, sp)                        ''    (returning byref)
End Operator                                         ''    to behave as pointer
 

Scope
    Dim sp1 As SmartPointer
    Print "'" & sp1->s & "'"
    sp1->s = "object #1"
    Print "'" & sp1->s & "'"
    Print
 
    Dim sp2 As SmartPointer = sp1
    Print "'" & (*sp2).s & "'"
    (*sp2).s = "object #2"
    Print "'" & (*sp2).s & "'"
    Print
 
    Dim sp3 As SmartPointer = sp1
    Print "'" & sp3->s & "'"
    *sp3 = *sp2
    Print "'" & sp3->s & "'"
    sp3->s = "object #3"
    Print "'" & sp3->s & "'"
    Print
End Scope

Sleep

SmartPointer construction 1703576
  UDT construction 10693312
SmartPointer operator '->'
'object #0'
SmartPointer operator '->'
SmartPointer operator '->'
'object #1'

SmartPointer copy-construction 1703524 from 1703576
  UDT construction 10693384
SmartPointer operator '*'
'object #1'
SmartPointer operator '*'
SmartPointer operator '*'
'object #2'

SmartPointer copy-construction 1703472 from 1703576
  UDT construction 10693456
SmartPointer operator '->'
'object #1'
SmartPointer operator '*'
SmartPointer operator '*'
SmartPointer operator '->'
'object #2'
SmartPointer operator '->'
SmartPointer operator '->'
'object #3'

SmartPointer destruction 1703472
  UDT destruction 10693456
SmartPointer destruction 1703524
  UDT destruction 10693384
SmartPointer destruction 1703576
  UDT destruction 10693312

#Macro Define_SmartPointer (_UDTname_)

    Type SmartPointer_##_UDTname_
        Public:
            Declare Constructor (ByVal rhs As _UDTname_ Ptr)              '' to construct smart pointer
            '                                                                '' from _UDTname_ pointer,
            '                                                                '' with reference counter increment
            Declare Static Function returnCount () As Integer             '' to return reference counter value
            Declare Operator Cast () As _UDTname_ Ptr                     '' to cast private _UDTname_ pointer
            '                                                                '' to _UDTname_ pointer (read only)
            Declare Operator Cast () As String                            '' to cast private _UDTname_ pointer
            '                                                                '' to string (read only)
            Declare Destructor ()                                         '' to destroy smart pointer
            '                                                                '' and _UDTname_ object
            '                                                                '' with reference counter decrement
        Private:
            Dim As _UDTname_ Ptr p                                        '' private _UDTname_ pointer
            Static As Integer Count                                       '' private reference counter
            Declare Constructor ()                                        '' to disallow default-construction
            Declare Constructor (ByRef rhs As SmartPointer_##_UDTname_)   '' to disallow copy-construction
            Declare Operator Let (ByRef rhs As SmartPointer_##_UDTname_)  '' to disallow copy-assignment
    End Type
    Dim As Integer SmartPointer_##_UDTname_.Count = 0

    Constructor SmartPointer_##_UDTname_ (ByVal rhs As _UDTname_ Ptr)
        If rhs <> 0 Then
            This.p = rhs
            SmartPointer_##_UDTname_.count += 1
        End If
    End Constructor

    Static Function SmartPointer_##_UDTname_.returnCount () As Integer
        Return SmartPointer_##_UDTname_.count
    End Function

    Operator SmartPointer_##_UDTname_.Cast () As _UDTname_ Ptr
        Return This.p
    End Operator

    Operator SmartPointer_##_UDTname_.Cast () As String
        Return Str(This.p)
    End Operator

    Destructor SmartPointer_##_UDTname_ ()
        If This.p <> 0 Then
            Delete This.p
            SmartPointer_##_UDTname_.count -= 1
            This.p = 0
        End If
    End Destructor

    Operator * (ByRef sp As SmartPointer_##_UDTname_) ByRef As _UDTname_  '' operator '*' (return byref)
        '                                                                    '' to behave as pointer
        Return ByVal sp                                                   '' 'Return *sp' would induce an infinite loop
    End Operator

    Operator -> (ByRef sp As SmartPointer_##_UDTname_) ByRef As _UDTname_  '' operator '->' (return byref)
        '                                                                     '' to behave as pointer
        Return ByVal sp
    End Operator

#Endmacro

'--------------------------------------------------------------------------------------------------------

' Example using all eight keywords of inheritance:
'   'Extends', 'Base.', 'Base()', 'Object', 'Is' operator, 'Virtual', 'Abstract', 'Override'

Type root Extends Object ' 'Extends' to activate RTTI by inheritance of predefined Object type
    Public:
        Declare Function ObjectHierarchy () As String
        Declare Function ObjectName () As String
        Declare Abstract Function ObjectRealType () As String  '' 'Abstract' declares function without local body
        '                                                         '' which must be overridden
        Declare Virtual Destructor ()                          '' 'Virtual' declares destructor
    Protected:
        Declare Constructor ()                                 '' to avoid default-construction from outside Types
        Declare Constructor (ByRef _name As String = "")       '' to avoid construction from outside Types
        Declare Constructor (ByRef rhs As root)                '' to avoid copy-construction from outside Types
        Declare Operator Let (ByRef rhs As root)               '' to avoid copy-assignment from outside Types
    Private:
        Dim Name As String
End Type                                                   '' derived type may be member data empty

Constructor root ()  '' only to avoid compile error (due to inheritance)
End Constructor

Constructor root (ByRef _name As String = "")              '' only to avoid compile error (due to inheritance)
    This.Name = _name
    Print "root constructor:", This.Name
End Constructor

Function root.ObjectHierarchy () As String
    Return "Object(forRTTI) <- root"
End Function

Function root.ObjectName () As String
    Return This.Name
End Function

Virtual Destructor root ()
    Print "root destructor:", This.Name
End Destructor

Operator root.Let (ByRef rhs As root)                      '' only to avoid compile error (due to onheritance)
End Operator


Type animal Extends root                                           '' 'Extends' to inherit of root
    Declare Constructor (ByRef _name As String = "")
    Declare Function ObjectHierarchy () As String
    Declare Virtual Function ObjectRealType () As String Override  '' 'Virtual' declares function with local
    '                                                              ''    body which can be overridden
    '                                                              '' 'Override' to check if the function is
    '                                                              ''    well an override
    Declare virtual Destructor () Override                         '' 'Virtual' declares destructor with local body
    '                                                              '' 'Override' to check if the destructor is well an override
End Type

Constructor animal (ByRef _name As String = "")
    Base(_name)                                                    '' 'Base()' allows to call parent constructor
    Print "  animal constructor:", This.ObjectName()
End Constructor

Function animal.ObjectHierarchy () As String
    Return Base.ObjectHierarchy & " <- animal"                     '' 'Base.' allows to access to parent member function
End Function

Virtual Function animal.ObjectRealType () As String
    Return "animal"
End Function

Virtual Destructor animal ()
    Print "  animal destructor:", This.ObjectName()
End Destructor


Type dog Extends animal                                    '' 'Extends' to inherit of animal
    Declare Constructor (ByRef _name As String = "")
    Declare Function ObjectHierarchy () As String
    Declare Function ObjectRealType () As String Override  '' 'Override' to check if the function is well an
    '                                                      ''    override
    Declare Destructor () Override                         '' 'Override' to check if the destructor is well an override
End Type                                                   '' derived type may be member data empty

Constructor dog (ByRef _name As String = "")
    Base(_name)                                            '' 'Base()' allows to call parent constructor
    Print "    dog constructor:", This.ObjectName()
End Constructor

Function dog.ObjectHierarchy () As String
    Return Base.ObjectHierarchy & " <- dog"                '' 'Base.' allows to access to parent member function
End Function

Function dog.ObjectRealType () As String
    Return "dog"
End Function

Destructor dog ()
    Print "    dog destructor:", This.ObjectName()
End Destructor


Type cat Extends animal                                  '' 'Extends' to inherit of animal
    Declare Constructor (ByRef _name As String = "")
    Declare Function ObjectHierarchy () As String
    Declare Function ObjectRealType () As String Override  '' 'Override' to check if the function is well an
    '                                                      ''    override
    Declare Destructor () Override                         '' 'Override' to check if the destructor is well an override
End Type                                                   '' derived type may be member data empty

Constructor cat (ByRef _name As String = "")
    Base(_name)                                            '' 'Base()' allows to call parent constructor
    Print "    cat constructor:", This.ObjectName()
End Constructor

Function cat.ObjectHierarchy () As String
    Return Base.ObjectHierarchy & " <- cat"                '' 'Base.' allows to access to parent member function
End Function

Function cat.ObjectRealType () As String
    Return "cat"
End Function

Destructor cat ()
    Print "    cat destructor:", This.ObjectName()
End Destructor


Sub PrintInfo (ByVal p As root Ptr)                                       '' parameter is a 'root Ptr' or compatible (smart pointer)
    Print "  " & p->ObjectName, "  " & p->ObjectRealType, "           ";
    If *p Is dog Then                                                     '' 'Is' allows to check compatibility with type symbol
        Print  Cast(dog Ptr, p)->ObjectHierarchy
    ElseIf *p Is cat Then                                                 '' 'Is' allows to check compatibility with type symbol
        Print Cast(cat Ptr, p)->ObjectHierarchy
    ElseIf *p Is animal Then                                              '' 'Is' allows to check compatibility with type symbol
        Print Cast(animal Ptr, p)->ObjectHierarchy
    End If
End Sub


Define_SmartPointer(root)  '' smart pointer definition

Scope
    Print "reference counter value:"; SmartPointer_root.returnCount()
    Print
    Dim As SmartPointer_root sp(2) = {New animal("Mouse"), New dog("Buddy"), New cat("Tiger")}
    Print
    Print "reference counter value:"; SmartPointer_root.returnCount()
    For I As Integer = 0 To 2
        Print "  " & sp(I), sp(I)->ObjectName()
    Next I
    Print
    Print "Name:", "Object (real):         Hierarchy:"
    For I As Integer = 0 To 2
        PrintInfo(sp(I))
    Next I
    Print
End Scope
Print
Print "reference counter value:"; SmartPointer_root.returnCount()
Print

Sleep

reference counter value: 0

root constructor:           Mouse
  animal constructor:       Mouse
root constructor:           Buddy
  animal constructor:       Buddy
	dog constructor:        Buddy
root constructor:           Tiger
  animal constructor:       Tiger
	cat constructor:        Tiger

reference counter value: 3
  11145960    Mouse
  11151496    Buddy
  11151616    Tiger

Name:         Object (real):         Hierarchy:
  Mouse         animal                 Object(forRTTI) <- root <- animal
  Buddy         dog                    Object(forRTTI) <- root <- animal <- dog
  Tiger         cat                    Object(forRTTI) <- root <- animal <- cat

	cat destructor:         Tiger
  animal destructor:        Tiger
root destructor:            Tiger
	dog destructor:         Buddy
  animal destructor:        Buddy
root destructor:            Buddy
  animal destructor:        Mouse
root destructor:            Mouse

reference counter value: 0