Abstract/Virtual destructor/method behaviour

[fxm]

What I mean fxm is that pointers to the UDT's are not needed in the freebasic download build (.91), to access the virtual function.
I think a bug causes this.
The new build needs udt pointers.

I do not understand what you write!
Perhaps a simple example to highlight?

[fxm]

Strange thing though:
I need a reset field for the recursive method(else the function name will be printed many times)
But if I put this field in the basetype udt it doesn't work, even although the recursivetype extend the basetype?

'reset' is a keyword.
Change name (for example '_reset') and inheritance will work from base-type.

[dodicat]

I shall use the previous factorial example.(adjusted accordingly)
This works in version .91, but not in the latest build.
No pointers to udt's to access the virtual function!

_reset -- OK.
But here I only use it as a shared integer.

Code: Select all

 

Type basetype Extends Object
    Declare virtual Function factorial(As String) As String
    #define Intrange(f,l) int(Rnd*((l+1)-(f))+(f))
End Type

Type normaltype Extends basetype
    Declare Function factorial(As String) As String override
End Type

Type recursivetype Extends basetype
    Declare Function factorial(As String) As String override
End Type

Dim As basetype  F 'working value (not a pointer)

'reference values
'Dim As basetype      basic
'Dim As normaltype    normal
'Dim As recursivetype recursive

Dim As String i
dim shared as integer _reset
Do
    var n=str(IntRange(1,170)) '170 is float max for normal and recursive types
                               'basetype has no restrictions
    print "-------------------------"
    print "FACTORIAL ";n
    print
    F=basetype
    Print F.factorial(n)
    
    f=normaltype
    Print F.factorial(n)
    
    _reset=0 'only print header once during recursions
    f=recursivetype
    Print F.factorial(n)
    
    Print
    print "-------------------------"
    i=Input(1)
Loop Until i=Chr(27)
sleep


Function basetype.factorial(num As String) As String
    Print __function__;Tab(40);
    Dim  As Ubyte _Mod(0 To 99),_Div(0 To 99)
    For z As Integer=0 To 99:_Mod(z)=(z Mod 10+48):_Div(z)=z\10:Next
        Var fact="1",a="",b="",c=""
        Dim As Ubyte n,carry,ai
        For z As Integer=1 To Valint(num)
            a=fact:b=Str(z):Var la =Len(a),lb =Len(b)
            c =String(la+lb,"0")
            For i As Integer =la-1 To 0 Step -1
                carry=0:ai=a[i]-48
                For j As Integer =lb-1 To 0 Step -1
                    n =ai*(b[j]-48)+(c[i+j+1]-48)+carry
                    carry =_Div(n):c[i+j+1]=_Mod(n)
                Next j
                c[i]+=carry
            Next i
            fact=Ltrim(c,"0")
        Next z
        Return fact
    End Function
    
    Function normaltype.FACTORIAL(number As String)As String  'dont use recursive method here
        Print __function__;Tab(40);
        Dim temp As Double=1
        If number > "1" Then
            For n As Integer = 1 To Val(number)
                temp = temp * n
            Next
            normaltype.FACTORIAL =Str( temp)
        Else
            normaltype.factorial = "1"
        End If
        
    End Function
    
    
    Function recursivetype.factorial(num As String) As String
        If _reset=0 Then  Print __function__;Tab(40);:_reset=1
        If num >"1" Then
            Return Str(Val(num)*Val(factorial(Str(Valint(num)-1)))) 
        Else
            Return "1"
        End If
    End Function
    
    

[fxm]

Your program worked due to a bug which is corrected now:
#614 Operator = (assignment to a derived object) modifies RTTI

I already signaled you this problem and this behavior, depending on fbc version:
http://www.freebasic.net/forum/viewtopi ... 49#p193349

This works in version .91, but not in the latest build.

Remark:
- the last official version is 0.90.1
- the current build is 0.91

[dodicat]

Yes, I know fxm.
I wondered why you asked for an example here.

Anyway, thanks for the time, cheers for now.

[fxm]

I wondered why you asked for an example here.

Because of your confusion between version 0.90.1 and version 0.91.

[fxm]

FB's workaround to covariant function return types when return types are pointers to dynamic objects
(covariant return type is when overriding function returns a more derived type than overrided function)

Associated with polymorphism, the covariant return types are often useful in OOP language, and may avoid unsafe down-castings.

Presently FB does not support covariant return types.
The overriding function must have the same signature than the overrided function, and consequently the same return type.

A simple example is a clone function with return type being a base-type pointer.
The function return pointer value must be memorized in a typed pointer in order to be able to destroy the object when it becomes useless.

With polymorphism, no problem to create a clone of a derived object referenced by a based pointer, but we cannot create a clone of a derived object referenced by a derived pointer without casting the pointer explicitly:

Code: Select all

Type Parent Extends Object
  Declare Virtual Function clone () As Parent Ptr
  Declare Virtual Function typeName () As String
End Type
Virtual Function Parent.clone () As Parent Ptr
  Return New Parent(This)
End Function
Virtual Function Parent.typeName () As String
  Return "Parent"
End Function

Type Child Extends Parent
  Declare Virtual Function clone () As Parent Ptr Override
  Declare Virtual Function typeName () As String Override
End Type
Virtual Function Child.clone () As Parent Ptr
  Return New Child(This)
End Function
Virtual Function Child.typeName () As String
  Return "Child"
End Function


Dim As Parent Ptr ppc = New Child
Dim As Parent Ptr ppc1 = ppc->clone()  '' OK
Print ppc1->typeName()

Dim As Child Ptr pcc = New Child
'Dim As Child Ptr pcc1 = pcc->clone()  '' NOK: error 180: Invalid assignment/conversion
Dim As Child Ptr pcc1 = Cast(Child Ptr, pcc->clone())
Print pcc1->typeName()

Sleep
Delete ppc
Delete ppc1
Delete pcc
Delete pcc1

Code: Select all

Child
Child

Using the FB property than an 'Any Ptr' is compatible of any pointer, the polymorphic clone function can be defined with returning an 'Any Ptr' and none explicit casting is necessary when initializing the typed pointers, but the implicit casting is always unsafe:

Code: Select all

Type Parent Extends Object
  Declare Virtual Function clone () As Any Ptr
  Declare Virtual Function typeName () As String
End Type
Virtual Function Parent.clone () As Any Ptr
  Return New Parent(This)
End Function
Virtual Function Parent.typeName () As String
  Return "Parent"
End Function

Type Child Extends Parent
  Declare Virtual Function clone () As Any Ptr Override
  Declare Virtual Function typeName () As String Override
End Type
Virtual Function Child.clone () As Any Ptr
  Return New Child(This)
End Function
Virtual Function Child.typeName () As String
  Return "Child"
End Function


Dim As Parent Ptr ppc = New Child
Dim As Parent Ptr ppc1 = ppc->clone()  '' OK
Print ppc1->typeName()

Dim As Child Ptr pcc = New Child
Dim As Child Ptr pcc1 = pcc->clone()  '' OK
Print pcc1->typeName()

Sleep
Delete ppc
Delete ppc1
Delete pcc
Delete pcc1

Code: Select all

Child
Child

[fxm]

In C++ an overridden virtual function in a derived class must have the exact same signature of the function which is overridden in the base class, except for the return type which may return a pointer or reference to a derived type of the base class's return type (covariance).

I think that for virtual functions which return pointers (or references), allow the covariance on the return type should not be difficult to implement in FreeBASIC (extremely less difficult than interfaces or multiple inheritance).

Could this be implemented in the near future?

[fxm]

In C++ an overridden virtual function in a derived class must have the exact same signature of the function which is overridden in the base class, except for the return type which may return a pointer or reference to a derived type of the base class's return type (covariance).

I think that for virtual functions which return pointers (or references), allow the covariance on the return type should not be difficult to implement in FreeBASIC (extremely less difficult than interfaces or multiple inheritance).

Could this be implemented in the near future?

dkl thank you for the filling this feature request:
#289 Covariant parameters and function results

When overriding virtual methods, I guess that you also propose the ability of covariant type parameters in order (in addition to covariant return type) to also avoid the unsafe down-castings inside the overriding method body.

[fxm]

FB should support covariant type parameters for the overriding methods?

dkl thank you for the filling this feature request:
#289 Covariant parameters and function results

When overriding virtual methods, I guess that you also propose the ability of covariant type parameters in order (in addition to covariant return type) to also avoid the unsafe down-castings inside the overriding method body.

I wonder why C++ and Java support the covariance only for function returns (is there an additional difficulty for parameters compared to function returns, when passing or returning by reference or pointer?)!
Eiffel supports the covariance for the function returns and the parameters.

1) Example with two independant inheritance structures:
- animal <- cat, dog
- Object <- animalFarming <- catFarming, dogFarming

Code: Select all

Type animal
  Declare Constructor (Byref s As String = "")
  Dim As String species
End Type
Constructor animal (Byref s As String = "")
  This.species = s
End Constructor

Type cat Extends animal
  Declare Constructor ()
  Declare Constructor (Byref c As cat)
  Declare Destructor ()
  Static As Integer nb
End Type
Dim As integer cat.nb
Constructor cat ()
  Base("cat")
  This.nb += 1
End Constructor
Constructor cat (Byref c As cat)
  Base(c.species)
  This.nb += 1
End Constructor
Destructor cat ()
  This.nb -= 1
End Destructor

Type dog Extends animal
  Declare Constructor ()
  Declare Constructor (Byref d As dog)
  Declare Destructor ()
  Static As Integer nb
End Type
Dim As integer dog.nb
Constructor dog ()
  Base("dog")
  This.nb += 1
End Constructor
Constructor dog (Byref d As dog)
  Base(d.species)
  This.nb += 1
End Constructor
Destructor dog ()
  This.nb -= 1
End Destructor



Type animalFarming Extends Object
  Declare Abstract Function clone (Byref a As animal) As animal Ptr
End Type

Type catFarming Extends animalFarming
'  Declare Function clone (Byref c As cat) As cat Ptr Override          '' with covariance
  Declare Function clone (Byref a As animal) As animal Ptr Override  '' without covariance
End Type
'Function catFarming.clone (Byref c As cat) As cat Ptr                  '' with covariance
Function catFarming.clone (Byref a As animal) As animal Ptr          '' without covariance
'  Return New cat(c)                                                    '' with covariance
  Return New cat(*Cast(cat Ptr, @a))                                 '' without covariance
End Function

Type dogFarming Extends animalFarming
'  Declare Function clone (Byref d As dog) As dog Ptr Override          '' with covariance
  Declare Function clone (Byref a As animal) As animal Ptr Override  '' without covariance
End Type
'Function dogFarming.Clone (Byref d As dog) As dog Ptr                  '' with covariance
Function dogFarming.Clone (Byref a As animal) As animal Ptr          '' without covariance
'  Return New dog(d)                                                    '' with covariance
  Return New dog(*Cast(dog Ptr, @a))                                 '' without covariance
End Function



Dim As cat c
Print c.species & " #" & c.nb
Dim As dog d
Print d.species & " #" & d.nb
Print

Dim As catFarming cf
Dim As dogFarming df
Dim As animalFarming Ptr paf

Print "catFarming:",
paf = @cf
Dim As cat Ptr pcc
'pcc = paf->clone(c)                    '' with covariance
pcc = Cast(cat Ptr, paf->clone(c))   '' without covariance
Print pcc->species & " #" & pcc->nb
Print "dogFarming:",
paf = @df
Dim As dog Ptr pdc
'pdc = paf->clone(d)                    '' with covariance
pdc = Cast(dog Ptr, paf->clone(d))   '' without covariance
Print pdc->species & " #" & pdc->nb

Sleep
Delete pcc
Delete pdc

Code: Select all

cat #1
dog #1

catFarming:   cat #2
dogFarming:   dog #2

But without covariant type parameter supported, an unsafe down-casting must be added inside the overriding method body, and then nothing in the code above can forbid:
- to clone a cat with a dog in catFarming:
[89] pcc = Cast(cat Ptr, paf->clone(d))
- to clone a dog with a cat in dogFarming:
[95] pdc = Cast(dog Ptr, pdf->clone(c))

Code: Select all

cat #1
dog #1

catFarming:   dog #2
dogFarming:   cat #2

2) In order to safe the code (without covariant type parameter supported), the overriding method bodies must be complemented (5 lines instead of 1 line) by checking the real reference types before to authorize cloning:

Code: Select all

Type animal Extends Object
  Declare Constructor (Byref s As String = "")
  Dim As String species
End Type
Constructor animal (Byref s As String = "")
  This.species = s
End Constructor

Type cat Extends animal
  Declare Constructor ()
  Declare Constructor (Byref c As cat)
  Declare Destructor ()
  Static As Integer nb
End Type
Dim As Integer cat.nb
Constructor cat ()
  Base("cat")
  This.nb += 1
End Constructor
Constructor cat (Byref c As cat)
  Base(c.species)
  This.nb += 1
End Constructor
Destructor cat ()
  This.nb -= 1
End Destructor

Type dog Extends animal
  Declare Constructor ()
  Declare Constructor (Byref d As dog)
  Declare Destructor ()
  Static As Integer nb
End Type
Dim As Integer dog.nb
Constructor dog ()
  Base("dog")
  This.nb += 1
End Constructor
Constructor dog (Byref d As dog)
  Base(d.species)
  This.nb += 1
End Constructor
Destructor dog ()
  This.nb -= 1
End Destructor



Type animalFarming Extends Object
  Declare Abstract Function clone (Byref a As animal) As animal Ptr
End Type

Type catFarming Extends animalFarming
'  Declare Function clone (Byref c As cat) As cat Ptr Override          '' with covariance
  Declare Function clone (Byref a As animal) As animal Ptr Override  '' without covariance
End Type
'Function catFarming.clone (Byref c As cat) As cat Ptr                  '' with covariance
Function catFarming.clone (Byref a As animal) As animal Ptr          '' without covariance
'  Return New cat(c)                                                    '' with covariance
  Return Iif(a Is cat, New cat(*Cast(cat Ptr, @a)), 0)               '' without covariance
End Function

Type dogFarming Extends animalFarming
'  Declare Function clone (Byref d As dog) As dog Ptr Override          '' with covariance
  Declare Function clone (Byref a As animal) As animal Ptr Override  '' without covariance
End Type
'Function dogFarming.Clone (Byref d As dog) As dog Ptr                  '' with covariance
Function dogFarming.Clone (Byref a As animal) As animal Ptr          '' without covariance
'  Return New dog(d)                                                    '' with covariance
  Return Iif(a Is dog, New dog(*Cast(dog Ptr, @a)), 0)               '' without covariance
End Function



Dim As cat c
Print c.species & " #" & c.nb
Dim As dog d
Print d.species & " #" & d.nb
Print

Dim As catFarming cf
Dim As dogFarming df
Dim As animalFarming Ptr paf

Print "catFarming:",
paf = @cf
Dim As cat Ptr pcc
'pcc = paf->clone(c)                                           '' with covariance
'Print pcc->species & " #" & pcc->nb                           '' with covariance
pcc = Cast(cat Ptr, paf->clone(c))                          '' without covariance
If pcc Then Print pcc->species & " #" & pcc->nb Else Print  '' without covariance
Print "dogFarming:",
paf = @df
Dim As dog Ptr pdc
'pdc = paf->clone(d)                                           '' with covariance
'Print pdc->species & " #" & pdc->nb                           '' with covariance
pdc = Cast(dog Ptr, paf->clone(d))                          '' without covariance
If pdc Then Print pdc->species & " #" & pdc->nb Else Print  '' without covariance

Sleep
Delete pcc
Delete pdc

Code: Select all

cat #1
dog #1

catFarming:   cat #2
dogFarming:   dog #2

By checking the real reference types before authorizing the cloning, this avoids:
- to clone a cat with a dog in catFarming:
[90] pcc = Cast(cat Ptr, pcf->clone(d))
- to clone a dog with a cat in dogFarming:
[97] pdc = Cast(dog Ptr, pdf->clone(c))

Code: Select all

cat #1
dog #1

catFarming:
dogFarming:

Urges the override covariance for return and parameter types!

2bis) As (fortunately) a covariant type parameter is also requested (in addition to covariant type return), a more simple workaround exists which is to replace the base abstract function by several virtual specialized (with the requested subtypes) functions.
To forbid base object constructions (because of base function no longer abstract), a constructor and a copy-constructor with protected access can be added:

Code: Select all

Type animal
  Declare Constructor (Byref s As String = "")
  Dim As String species
End Type
Constructor animal (Byref s As String = "")
  This.species = s
End Constructor

Type cat Extends animal
  Declare Constructor ()
  Declare Constructor (Byref c As cat)
  Declare Destructor ()
  Static As Integer nb
End Type
Dim As integer cat.nb
Constructor cat ()
  Base("cat")
  This.nb += 1
End Constructor
Constructor cat (Byref c As cat)
  Base(c.species)
  This.nb += 1
End Constructor
Destructor cat ()
  This.nb -= 1
End Destructor

Type dog Extends animal
  Declare Constructor ()
  Declare Constructor (Byref d As dog)
  Declare Destructor ()
  Static As Integer nb
End Type
Dim As integer dog.nb
Constructor dog ()
  Base("dog")
  This.nb += 1
End Constructor
Constructor dog (Byref d As dog)
  Base(d.species)
  This.nb += 1
End Constructor
Destructor dog ()
  This.nb -= 1
End Destructor



Type animalFarming Extends Object
'  Declare Abstract Function clone (Byref a As animal) As animal Ptr     '' with covariance
  Declare Virtual Function clone (Byref c As cat) As cat Ptr          '' without covariance
  Declare Virtual Function clone (Byref d As dog) As dog Ptr          '' without covariance
  Protected:                                                          '' without covariance
    Declare Constructor ()                                            '' without covariance
    Declare Constructor (Byref af As animalFarming)                   '' without covariance
End Type
Virtual Function animalFarming.clone (Byref c As cat) As cat Ptr
  Return 0
End Function
Virtual Function animalFarming.clone (Byref d As dog) As dog Ptr
  Return 0
End Function
Constructor animalFarming ()
End Constructor

Type catFarming Extends animalFarming
  Declare Function clone (Byref c As cat) As cat Ptr Override
End Type
Function catFarming.clone (Byref c As cat) As cat Ptr
  Return New cat(c)
End Function

Type dogFarming Extends animalFarming
  Declare Function clone (Byref d As dog) As dog Ptr Override
End Type
Function dogFarming.Clone (Byref d As dog) As dog Ptr
  Return New dog(d)
End Function



Dim As cat c
Print c.species & " #" & c.nb
Dim As dog d
Print d.species & " #" & d.nb
Print

Dim As catFarming cf
Dim As dogFarming df
Dim As animalFarming Ptr paf

Print "catFarming:",
paf = @cf
Dim As cat Ptr pcc
pcc = paf->clone(c)
'Print pcc->species & " #" & pcc->nb                           '' with covariance
If pcc Then Print pcc->species & " #" & pcc->nb Else Print  '' without covariance
Print "dogFarming:",
paf = @df
Dim As dog Ptr pdc
pdc = paf->clone(d)
'Print pdc->species & " #" & pdc->nb                           '' with covariance
If pdc Then Print pdc->species & " #" & pdc->nb Else Print  '' without covariance

Sleep
Delete pcc
Delete pdc

Code: Select all

cat #1
dog #1

catFarming:   cat #2
dogFarming:   dog #2

By assigning specialized pointers, this avoids:
- to clone a cat with a dog in catFarming:
[96] pcc = pcf->clone(d)
- to clone a dog with a cat in dogFarming:
[105] pdc = pdf->clone(c)

Code: Select all

Compiler output:
.....\FBIDETEMP.bas(96) error 180: Invalid assignment/conversion in 'pcc = paf->clone(d)'
.....\FBIDETEMP.bas(105) error 180: Invalid assignment/conversion in 'pdc = paf->clone(c)'

[edit]
- Code complemented (§2) to obtain a safer version without covariance supported.
- Added paragraph (§2bis).
- See the other version at http://www.freebasic.net/forum/viewtopi ... 21#p202321 (by using a macro for 'dynamic cast to pointer').

[marcov]

FB should support covariant type parameters for the overriding methods?

dkl thank you for the filling this feature request:
#289 Covariant parameters and function results

When overriding virtual methods, I guess that you also propose the ability of covariant type parameters in order (in addition to covariant return type) to also avoid the unsafe down-castings inside the overriding method body.

I wonder why C++ and Java support the covariance only for function returns (is there an additional difficulty for parameters compared to function returns, when passing or returning by reference or pointer?)!

Well, coming from Delphi I'd say overloading is allowed based on parameters, but not on function result.

The more degrees of freedom you have (overloading, automatic type conversions, auto dereference, and boxing/unboxing like operations), it gets more difficult to match signatures.

The trick is not proving it works in some simple cases. The trick is proving it gives a sane result always (and e.g. warn in cases of doubt)

[fxm]

From http://en.wikipedia.org/wiki/Covariance ... science%29:

Code: Select all

'                                                  | Parameter type | Return type |
'--------------------------------------------------|----------------|-------------|
'C++ (since 1998), Java (since J2SE 5.0), Scala, D |   Invariant    |  Covariant  |
'C#                                                |   Invariant    |  Invariant  |
'Sather                                            | Contravariant  |  Covariant  |
'Eiffel                                            |   Covariant    |  Covariant  |

[fxm]

Polymorphism through base-type pointers or base-type references

As many people know, base-type pointers (or dereferenced base-type pointers) referring to derived-type objects allow the polymorphism by using inheritance and virtuality.

But perhaps far fewer people know (or use it) that base-type references referring to derived-type objects also allow the polymorphism by using inheritance and virtuality.

Besides, polymorphism by the inheritance and virtuality allows to avoid a crash caused by an illicit static down casting, inducing an illicit access:
- Indeed, the virtual procedure executed is always that of the vtable pointer initialized during the initial object construction.
- The pointer index in vtable corresponds to the rank of the first virtual declaration of procedure, and never changes even in case of up/down casting of the calling instance (reference or pointer).
- The polymorphism by the inheritance and virtuality allows to move not only down in hierarchy but also to move up in hierarchy, compared to the static type (apparent type at compilation time) of the calling instance (reference or pointer).


Examples with up/down casting the static type (apparent type at compilation time) of the calling instance (reference or pointer):

- With virtual procedure (compile with fbc version >= 1.00.0):

Code: Select all

Type Parent Extends Object
  Public:
    Dim As Integer I
    Declare Constructor (Byval I As Integer = 0)
    Declare Function info () As String
  Private:
    Declare Function dynamicTypenanme () As String
  Protected:
    Declare Virtual Function runtimeInfo () As String
End Type
Constructor Parent (Byval I As Integer = 0)
  This.I = I
End Constructor
Function Parent.info () As String
  Return "   Parent   |    " & This.runtimeInfo()
End Function
Virtual Function Parent.runtimeInfo () As String
  Return This.dynamicTypenanme() & "   |     " & This.I & "      |     "
End Function

Type Child Extends Parent
  Public:
    Dim As Integer J
    Declare Constructor (Byval I As Integer = 0, Byval J As Integer = 0)
    Declare Function info () As String
  Protected:
    Declare Virtual Function runtimeInfo () As String
End type
Constructor Child (Byval I As Integer = 0, Byval J As Integer = 0)
  Base(I)
  This.J = J
End Constructor
Function Child.info () As String
  Return "   Child    |    " & This.runtimeInfo()
End Function
Virtual Function Child.runtimeInfo () As String
  Return Base.runtimeInfo() & This.J
End Function

Function Parent.dynamicTypenanme () As String
  Dim As Object Ptr po = @This
  If *po Is Child Then Return "Child "
  If *po Is Parent Then Return "Parent"
  Return "Object"
End Function

Function upCastStaticObject Overload (Byref c As Child) Byref As Parent
  Return c
End Function
Function upCastStaticObject Overload (Byval pc As Child Ptr) As Parent Ptr
  Return pc
End Function

Function downCastStaticObject Overload (Byref p As Parent) Byref As Child
  Return *Cast(Child Ptr, @p)
End Function
Function downCastStaticObject Overload (Byref pp As Parent Ptr) As Child Ptr
  Return Cast(Child Ptr, pp)
End Function


Print "---------------------------------------------------------------------"
Print "               OBJECT TYPE               |        MEMBER DATA        "
Print "    real     |    static   |   dynamic   |   Parent    |    Child    " 
Print " (construct) |  (compile)  |    (run)    |   (base)    |  (derived)  "
Print "-------------+-------------+-------------+-------------+-------------"
Print "                      access through reference"                                                    

Dim As Parent p = Parent(12)
Print "    Parent   | ";
Print p.info()
Print "    Parent   | ";
Print downCastStaticObject(p).info()

Dim As Child c = Child(12, 34)
Print "    Child    | ";
Print c.info()
Print "    Child    | ";
Print upCastStaticObject(c).info
Print "-------------+-------------+-------------+-------------+-------------"
Print "                       access through pointer"                                                    

Dim As Parent Ptr ppp = @p
Print "    Parent   | ";
Print ppp->info()
Print "    Parent   | ";
Print downCastStaticObject(ppp)->info()

Dim As Child Ptr pcc = @c
Print "    Child    | ";
Print pcc->info()
Print "    Child    | ";
Print upCastStaticObject(pcc)->info()

Sleep

Code: Select all

'---------------------------------------------------------------------
'               OBJECT TYPE               |        MEMBER DATA
'    real     |    static   |   dynamic   |   Parent    |    Child
' (construct) |  (compile)  |    (run)    |   (base)    |  (derived)
'-------------+-------------+-------------+-------------+-------------
'                      access through reference
'    Parent   |    Parent   |    Parent   |     12      |
'    Parent   |    Child    |    Parent   |     12      |
'    Child    |    Child    |    Child    |     12      |     34
'    Child    |    Parent   |    Child    |     12      |     34
'-------------+-------------+-------------+-------------+-------------
'                       access through pointer
'    Parent   |    Parent   |    Parent   |     12      |
'    Parent   |    Child    |    Parent   |     12      |
'    Child    |    Child    |    Child    |     12      |     34
'    Child    |    Parent   |    Child    |     12      |     34

None illicit access.

- With non virtual procedure:

Code: Select all

Type Parent Extends Object
  Public:
    Dim As Integer I
    Declare Constructor (Byval I As Integer = 0)
    Declare Function info () As String
  Private:
    Declare Function dynamicTypenanme () As String
  Protected:
    Declare Function runtimeInfo () As String
End Type
Constructor Parent (Byval I As Integer = 0)
  This.I = I
End Constructor
Function Parent.info () As String
  Return "   Parent   |    " & This.runtimeInfo()
End Function
Function Parent.runtimeInfo () As String
  Return This.dynamicTypenanme() & "   |     " & This.I & "      |     "
End Function

Type Child Extends Parent
  Public:
    Dim As Integer J
    Declare Constructor (Byval I As Integer = 0, Byval J As Integer = 0)
    Declare Function info () As String
  Protected:
    Declare Function runtimeInfo () As String
End type
Constructor Child (Byval I As Integer = 0, Byval J As Integer = 0)
  Base(I)
  This.J = J
End Constructor
Function Child.info () As String
  Return "   Child    |    " & This.runtimeInfo()
End Function
Function Child.runtimeInfo () As String
  Return Base.runtimeInfo() & This.J
End Function

Function Parent.dynamicTypenanme () As String
  Dim As Object Ptr po = @This
  If *po Is Child Then Return "Child "
  If *po Is Parent Then Return "Parent"
  Return "Object"
End Function

Function upCastStaticObject Overload (Byref c As Child) Byref As Parent
  Return c
End Function
Function upCastStaticObject Overload (Byval pc As Child Ptr) As Parent Ptr
  Return pc
End Function

Function downCastStaticObject Overload (Byref p As Parent) Byref As Child
  Return *Cast(Child Ptr, @p)
End Function
Function downCastStaticObject Overload (Byref pp As Parent Ptr) As Child Ptr
  Return Cast(Child Ptr, pp)
End Function


Print "---------------------------------------------------------------------"
Print "               OBJECT TYPE               |        MEMBER DATA        "
Print "    real     |    static   |   dynamic   |   Parent    |    Child    " 
Print " (construct) |  (compile)  |    (run)    |   (base)    |  (derived)  "
Print "-------------+-------------+-------------+-------------+-------------"
Print "                      access through reference"                                                    

Dim As Parent p = Parent(12)
Print "    Parent   | ";
Print p.info()
Print "    Parent   | ";
Print downCastStaticObject(p).info()

Dim As Child c = Child(12, 34)
Print "    Child    | ";
Print c.info()
Print "    Child    | ";
Print upCastStaticObject(c).info
Print "-------------+-------------+-------------+-------------+-------------"
Print "                       access through pointer"                                                    

Dim As Parent Ptr ppp = @p
Print "    Parent   | ";
Print ppp->info()
Print "    Parent   | ";
Print downCastStaticObject(ppp)->info()

Dim As Child Ptr pcc = @c
Print "    Child    | ";
Print pcc->info()
Print "    Child    | ";
Print upCastStaticObject(pcc)->info()

Sleep

Code: Select all

'---------------------------------------------------------------------
'               OBJECT TYPE               |        MEMBER DATA
'    real     |    static   |   dynamic   |   Parent    |    Child
' (construct) |  (compile)  |    (run)    |   (base)    |  (derived)
'-------------+-------------+-------------+-------------+-------------
'                      access through reference
'    Parent   |    Parent   |    Parent   |     12      |
'    Parent   |    Child    |    Parent   |     12      |     0
'    Child    |    Child    |    Child    |     12      |     34
'    Child    |    Parent   |    Child    |     12      |
'-------------+-------------+-------------+-------------+-------------
'                       access through pointer
'    Parent   |    Parent   |    Parent   |     12      |
'    Parent   |    Child    |    Parent   |     12      |     0
'    Child    |    Child    |    Child    |     12      |     34
'    Child    |    Parent   |    Child    |     12      |

Both illicit access correspond to static (at compile time) type = Child when dynamic (at run time) type = Parent.

[fxm]

Polymorphism through base-type pointers or base-type references

As many people know, base-type pointers (or dereferenced base-type pointers) referring to derived-type objects allow the polymorphism by using inheritance and virtuality.

But perhaps far fewer people know (or use it) that base-type references referring to derived-type objects also allow the polymorphism by using inheritance and virtuality.

Besides, polymorphism by the inheritance and virtuality allows to avoid a crash caused by an illicit static down casting, inducing an illicit access:
- Indeed, the virtual procedure executed is always that of the vtable pointer initialized during the initial object construction.
- The pointer index in vtable corresponds to the rank of the first virtual declaration of procedure, and never changes even in case of up/down casting of the calling instance (reference or pointer).
- The polymorphism by the inheritance and virtuality allows to move not only down in hierarchy but also to move up in hierarchy, compared to the static type (apparent type at compilation time) of the calling instance (reference or pointer).
.....

So, by putting in all public sections only virtual procedures and constructors (as virtual subroutines, virtual functions, virtual properties, virtual destructors), this prevents any illicit access even in case of illicit down casting of the calling instance (reference or pointer):

- Example with member data in public sections:

Code: Select all

Type Parent Extends Object
  Public:
    Declare Constructor (Byval I0 As Integer = 0)
    Dim As Integer I
End Type
Constructor Parent (Byval I0 As Integer = 0)
  This.I = I0
End Constructor

Type Child Extends Parent
  Public:
    Declare Constructor (Byval I0 As Integer = 0, Byval J0 As Integer = 0)
    Dim As Integer J
End type
Constructor Child (Byval I0 As Integer = 0, Byval J0 As Integer = 0)
  Base(I0)
  This.J = J0
End Constructor

Function upCastStaticObject Overload (Byref c As Child) Byref As Parent
  Return c
End Function
Function upCastStaticObject Overload (Byval pc As Child Ptr) As Parent Ptr
  Return pc
End Function

Function downCastStaticObject Overload (Byref p As Parent) Byref As Child
  Return *Cast(Child Ptr, @p)
End Function
Function downCastStaticObject Overload (Byref pp As Parent Ptr) As Child Ptr
  Return Cast(Child Ptr, pp)
End Function


Dim As Parent p = Parent(12)
Print p.I
Print downCastStaticObject(p).I, downCastStaticObject(p).J
Dim As Child c = Child(12, 34)
Print c.I, c.J
Print upCastStaticObject(c).I
Print

Dim As Parent Ptr ppp = @p
Print ppp->I
Print downCastStaticObject(ppp)->I, downCastStaticObject(ppp)->J
Dim As Child Ptr pcc = @c
Print pcc->I, pcc->J
Print upCastStaticObject(pcc)->I

Sleep

Code: Select all

 12
 12            0
 12            34
 12

 12
 12            0
 12            34
 12

'downCastStaticObject(p).J' or 'downCastStaticObject(ppp)->J' induces an illicit access (result = 0 for my execution)

- Example with only virtual properties (+ constructors) in public sections:

Code: Select all

Type Parent Extends Object
  Public:
    Declare Constructor (Byval I0 As Integer = 0)
    Declare Virtual Property I () As Integer
    Declare Virtual Property I (Byval I0 As Integer)
    Declare Virtual Property J () As Integer
    Declare Virtual Property J (Byval J0 As Integer)
  Protected:
    Dim As Integer _I
End Type
Constructor Parent (Byval I0 As Integer = 0)
  This._I = I0
End Constructor
Virtual Property Parent.I () As Integer
  Return This._I
End Property
Virtual Property Parent.I (Byval I0 As Integer)
  This._I = I0
End Property
Virtual Property Parent.J () As Integer
  Return -1
End Property
Virtual Property Parent.J (Byval I0 As Integer)
End Property

Type Child Extends Parent
  Public:
    Declare Constructor (Byval I0 As Integer = 0, Byval J0 As Integer = 0)
    Declare Virtual Property J () As Integer
    Declare Virtual Property J (Byval J0 As Integer)
    Declare Virtual Property I () As Integer
    Declare Virtual Property I (Byval I0 As Integer)
  Protected:
    Dim As Integer _J
End type
Constructor Child (Byval I0 As Integer = 0, Byval J0 As Integer = 0)
  Base(I0)
  This._J = J0
End Constructor
Virtual Property Child.J () As Integer
  Return This._J
End Property
Virtual Property Child.J (Byval J0 As Integer)
  This._J = J0
End Property
Virtual Property Child.I () As Integer
  Return Base._I
End Property
Virtual Property Child.I (Byval I0 As Integer)
  Base._I = i0
End Property

Function upCastStaticObject Overload (Byref c As Child) Byref As Parent
  Return c
End Function
Function upCastStaticObject Overload (Byval pc As Child Ptr) As Parent Ptr
  Return pc
End Function

Function downCastStaticObject Overload (Byref p As Parent) Byref As Child
  Return *Cast(Child Ptr, @p)
End Function
Function downCastStaticObject Overload (Byref pp As Parent Ptr) As Child Ptr
  Return Cast(Child Ptr, pp)
End Function


Dim As Parent p = Parent(12)
Print p.I, p.J
Print downCastStaticObject(p).I, downCastStaticObject(p).J
Dim As Child c = Child(12, 34)
Print c.I, c.J
Print upCastStaticObject(c).I, upCastStaticObject(c).J
Print

Dim As Parent Ptr ppp = @p
Print ppp->I, ppp->J
Print downCastStaticObject(ppp)->I, downCastStaticObject(ppp)->J
Dim As Child Ptr pcc = @c
Print pcc->I, pcc->J
Print upCastStaticObject(pcc)->I, upCastStaticObject(pcc)->J

Sleep

Code: Select all

 12           -1
 12           -1
 12            34
 12            34

 12           -1
 12           -1
 12            34
 12            34

'p.J', 'downCastStaticObject(p).J', 'ppp->J' or 'downCastStaticObject(ppp)->J' induces an checked call to avoid illicit access (result = -1)

[fxm]

@dkl

I come back to one of my previous posts:
http://www.freebasic.net/forum/viewtopi ... 79#p197879

But all the virtual member operators are impacted by this behavior, not only the destructor (only methods are not impacted):
(following example with in addition an assign let operator, a '+=' operator, a "@" operator and a cast operator)

Code: Select all

Type UDT1 Extends Object
  Declare Virtual Sub Method ()
  Declare Virtual Operator Cast () As String
  Declare Virtual Operator += (Byval I As Integer)
  Declare Virtual Operator Let (Byval I As Integer)
  Declare Virtual Operator @ () As Zstring Ptr
  Declare Virtual Destructor ()
End type
Sub UDT1.Method ()
  Print "UDT1.Method()"
End Sub
Operator UDT1.Cast () As String
  Return "UDT1.Cast() As String"
End Operator
Operator UDT1.+= (Byval I As Integer)
  Print "UDT1.+=(Byval As Integer)"
End Operator
Operator UDT1.Let (Byval I As Integer)
  Print "UDT1.Let(Byval As Integer)"
End Operator
Operator UDT1.@ () As Zstring Ptr
  Return @"UDT1.@() As Zstring Ptr"
End Operator
Destructor UDT1 ()
  Print "UDT1.Destructor()"
End destructor

Type UDT2 Extends UDT1
End type

Type UDT3 Extends UDT2
  Declare Virtual Sub Method ()                     '' Override
  Declare Virtual Operator Cast () As String        '' Override
  Declare Virtual Operator += (Byval I As Integer)  '' Override
  Declare Virtual Operator Let (Byval I As Integer) '' Override
  Declare Virtual Operator @ () As Zstring Ptr      '' Override
  Declare Virtual Destructor ()                     '' Override
End type
Sub UDT3.Method ()
  Print "UDT3.Method()"
End Sub
Operator UDT3.Cast () As String
  Return "UDT3.Cast() As String"
End Operator
Operator UDT3.+= (Byval I As Integer)
  Print "UDT3.+=(Byval As Integer)"
End Operator
Operator UDT3.Let (Byval I As Integer)
  Print "UDT3.Let(Byval As Integer)"
End Operator
Operator UDT3.@ () As Zstring Ptr
  Return @"UDT3.@() As Zstring Ptr"
End Operator
Destructor UDT3 ()
  Print "UDT3.Destructor()"
End destructor


Dim As UDT1 Ptr p = New UDT3
p->method()
Print
Print *p
Print
*p += 0
Print
*p = 0
Print
Print *(@(*p))
Print
Delete p

Sleep

Code: Select all

UDT3.Method()

UDT1.Cast() As String

UDT1.+=(Byval As Integer)

UDT1.Let(Byval As Integer)

UDT1.@() As Zstring Ptr

UDT1.Destructor()

How explain that?
- How the polymorphism (using inheritance and virtuality) is broken by the lack of definition of the assign let operator, the '+=' operator, the '@' operator and the 'cast' operator in UDT2, when that works for the member methods even un-defined in UDT2.
- This is as if implicit non-virtual operators in UDT2 override the base operators!
- But no, I think that for UDT2, only an implicit copy let operator and an implicit destructor (both non virtual) are created by compiler.
- So how to explain this behavior?

When these four operators are well defined as virtual in UDT2 (as the destructor, but not the method because useless), the polymorphism works well for the six:

Code: Select all

Type UDT1 Extends Object
  Declare Virtual Sub Method ()
  Declare Virtual Operator Cast () As String
  Declare Virtual Operator += (Byval I As Integer)
  Declare Virtual Operator Let (Byval I As Integer)
  Declare Virtual Operator @ () As Zstring Ptr
  Declare Virtual Destructor ()
End type
Sub UDT1.Method ()
  Print "UDT1.Method()"
End Sub
Operator UDT1.Cast () As String
  Return "UDT1.Cast() As String"
End Operator
Operator UDT1.+= (Byval I As Integer)
  Print "UDT1.+=(Byval As Integer)"
End Operator
Operator UDT1.Let (Byval I As Integer)
  Print "UDT1.Let(Byval As Integer)"
End Operator
Operator UDT1.@ () As Zstring Ptr
  Return @"UDT1.@() As Zstring Ptr"
End Operator
Destructor UDT1 ()
  Print "UDT1.Destructor()"
End destructor

Type UDT2 Extends UDT1
  Declare Virtual Operator Cast () As String        '' Override
  Declare Virtual Operator += (Byval I As Integer)  '' Override
  Declare Virtual Operator Let (Byval I As Integer) '' Override
  Declare Virtual Operator @ () As Zstring Ptr      '' Override
  Declare Virtual Destructor ()                     '' Override
End type
Operator UDT2.Cast () As String
  Return "UDT2.Cast() As String"
End Operator
Operator UDT2.+= (Byval I As Integer)
  Print "UDT2.+=(Byval As Integer)"
End Operator
Operator UDT2.Let (Byval I As Integer)
  Print "UDT2.Let(Byval As Integer)"
End Operator
Operator UDT2.@ () As Zstring Ptr
  Return @"UDT2.@() As Zstring Ptr"
End Operator
Destructor UDT2 ()
  Print "UDT2.Destructor()"
End destructor

Type UDT3 Extends UDT2
  Declare Virtual Sub Method ()                     '' Override
  Declare Virtual Operator Cast () As String        '' Override
  Declare Virtual Operator += (Byval I As Integer)  '' Override
  Declare Virtual Operator Let (Byval I As Integer) '' Override
  Declare Virtual Operator @ () As Zstring Ptr      '' Override
  Declare Virtual Destructor ()                     '' Override
End type
Sub UDT3.Method ()
  Print "UDT3.Method()"
End Sub
Operator UDT3.Cast () As String
  Return "UDT3.Cast() As String"
End Operator
Operator UDT3.+= (Byval I As Integer)
  Print "UDT3.+=(Byval As Integer)"
End Operator
Operator UDT3.Let (Byval I As Integer)
  Print "UDT3.Let(Byval As Integer)"
End Operator
Operator UDT3.@ () As Zstring Ptr
  Return @"UDT3.@() As Zstring Ptr"
End Operator
Destructor UDT3 ()
  Print "UDT3.Destructor()"
End destructor


Dim As UDT1 Ptr p = New UDT3
p->method()
Print
Print *p
Print
*p += 0
Print
*p = 0
Print
Print *(@(*p))
Print
Delete p

Sleep

Code: Select all

UDT3.Method()

UDT3.Cast() As String

UDT3.+=(Byval As Integer)

UDT3.Let(Byval As Integer)

UDT3.@() As Zstring Ptr

UDT3.Destructor()
UDT2.Destructor()
UDT1.Destructor()