Macro for static up/down cast in a user inheritance structure extending 'Object'

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
fxm
Moderator
Posts: 12016
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Macro for static up/down cast in a user inheritance structure extending 'Object'

Post by fxm »

This macro allows to declare and define a reference to an instance in an inheritance structure (deriving from 'Object'), while choosing its static (compile-time) type among the different types available in the user inheritance structure.
If the requested static type is not compatible with the instance, a null reference is defined, otherwise a reference to the provided instance is defined.
In the inheritance structure, the user base must extends 'Object'.

Code: Select all

#macro OOP_static_cast(input_instance, to_cast_type, output_reference)
    ' In the inheritance structure, the user base must extends 'Object'.
    ' From an undeclared reserved name ('output_reference'),
    '    this macro provides a typed ('to_cast_type') reference to the passed instance ('input_instance').
    ' If the cast succeeds, @output_reference = @input_instance.
    ' Yf the cast fails, @output_reference = 0
    
    Dim Byref As to_cast_type output_reference = *Cptr(to_cast_type Ptr, 0)
    If Cast(Object, input_instance) Is to_cast_type Then
        @output_reference = Cptr(to_cast_type Ptr, @input_instance)
    End If
#endmacro

- Complete test example with the following inheritance structure:

Code: Select all

'                          <-- cat <-- supercat   (derived from animal)
'    ( Object <-- ) animal 
'                          <-- dog                (derived from animal)

Code: Select all

#macro OOP_static_cast(input_instance, to_cast_type, output_reference)
    ' In the inheritance structure, the user base must extends 'Object'.
    ' From an undeclared reserved name ('output_reference'),
    '    this macro provides a typed ('to_cast_type') reference to the passed instance ('input_instance').
    ' If the cast succeeds, @output_reference = @input_instance.
    ' Yf the cast fails, @output_reference = 0
    
    Dim Byref As to_cast_type output_reference = *Cptr(to_cast_type Ptr, 0)
    If Cast(Object, input_instance) Is to_cast_type Then
        @output_reference = Cptr(to_cast_type Ptr, @input_instance)
    End If
#endmacro


Type animal Extends Object
    Declare Function compile_time_IS() As String
    Declare Virtual Function run_time_IS() As String
End Type

Function animal.compile_time_IS() As String
    Return "compile-time type is an 'animal'"
End Function

Function animal.run_time_IS() As String
    Return "run-time type is an 'animal'"
End Function

Type cat Extends animal
    Declare Function compile_time_IS() As String
    Declare Virtual Function run_time_IS() As String
End Type

Function cat.compile_time_IS() As String
    Return "compile-time type is a 'cat'"
End Function

Function cat.run_time_IS() As String
    Return "run-time type is a 'cat'"
End Function

Type dog Extends animal
    Declare Function compile_time_IS() As String
    Declare Virtual Function run_time_IS() As String
End Type

Function dog.compile_time_IS() As String
    Return "compile-time type is a 'dog'"
End Function

Function dog.run_time_IS() As String
    Return "run-time type is a 'dog'"
End Function

Type supercat Extends cat
    Declare Function compile_time_IS() As String
    Declare Virtual Function run_time_IS() As String
End Type

Function supercat.compile_time_IS() As String
    Return "compile-time type is a 'supercat'"
End Function

Function supercat.run_time_IS() As String
    Return "run-time type is a 'supercat'"
End Function


Dim As animal a
Print "'Dim As animal a':"
Print "   instance a: " & a.compile_time_IS()
Print "   instance a: " & a.run_time_IS()
OOP_static_cast(a, cat, rca)
Print "'OOP_static_cast(a, cat, rca)':"
If @rca = @a Then
    Print "   reference rca: " & rca.compile_time_IS()
    Print "   reference rca: " & rca.run_time_IS()
Elseif @rca = 0 Then
    Print "   null reference rca (@rca = 0)"
End If
Print

Dim Byref As animal ac = *New cat()
Print "'Dim Byref As animal ac = *New cat()':"
Print "   reference ac: " & ac.compile_time_IS()
Print "   reference ac: " & ac.run_time_IS()
OOP_static_cast(ac, cat, rcc)
Print "'OOP_static_cast(ac, cat, rcc)':"
If @rcc = @ac Then
    Print "   reference rcc: " & rcc.compile_time_IS()
    Print "   reference rcc: " & rcc.run_time_IS()
Elseif @rcc = 0 Then
    Print "   null reference rcc (@rcc = 0)"
End If
OOP_static_cast(ac, animal, rac)
Print "'OOP_static_cast(ac, animal, rac)':"
If @rac = @ac Then
    Print "   reference rac: " & rac.compile_time_IS()
    Print "   reference rac: " & rac.run_time_IS()
Elseif @rac = 0 Then
    Print "   null reference rac (@rac = 0)"
End If
OOP_static_cast(ac, supercat, rsc)
Print "'OOP_static_cast(ac, dog, rsc)':"
If @rsc = @ac Then
    Print "   reference rsc: " & rsc.compile_time_IS()
    Print "   reference rsc: " & rsc.run_time_IS()
Elseif @rsc = 0 Then
    Print "   null reference rsc (@rsc = 0)"
End If
OOP_static_cast(ac, dog, rdc)
Print "'OOP_static_cast(ac, supercat, rdc)':"
If @rdc = @ac Then
    Print "   reference rdc: " & rdc.compile_time_IS()
    Print "   reference rdc: " & rdc.run_time_IS()
Elseif @rdc = 0 Then
    Print "   null reference rdc (@rdc = 0)"
End If
Print

Delete @ac
Sleep
Output:

Code: Select all

'Dim As animal a':
   instance a: compile-time type is an 'animal'
   instance a: run-time type is an 'animal'
'OOP_static_cast(a, cat, rca)':
   null reference rca (@rca = 0)

'Dim Byref As animal ac = *New cat()':
   reference ac: compile-time type is an 'animal'
   reference ac: run-time type is a 'cat'
'OOP_static_cast(ac, cat, rcc)':
   reference rcc: compile-time type is a 'cat'
   reference rcc: run-time type is a 'cat'
'OOP_static_cast(ac, animal, rac)':
   reference rac: compile-time type is an 'animal'
   reference rac: run-time type is a 'cat'
'OOP_static_cast(ac, dog, rsc)':
   null reference rsc (@rsc = 0)
'OOP_static_cast(ac, supercat, rdc)':
   null reference rdc (@rdc = 0)

- Very simple example:

Code: Select all

#macro OOP_static_cast(input_instance, to_cast_type, output_reference)
    ' In the inheritance structure, the user base must extends 'Object'.
    ' From an undeclared reserved name ('output_reference'),
    '    this macro provides a typed ('to_cast_type') reference to the passed instance ('input_instance').
    ' If the cast succeeds, @output_reference = @input_instance.
    ' Yf the cast fails, @output_reference = 0
    
    Dim Byref As to_cast_type output_reference = *Cptr(to_cast_type Ptr, 0)
    If Cast(Object, input_instance) Is to_cast_type Then
        @output_reference = Cptr(to_cast_type Ptr, @input_instance)
    End If
#endmacro


Type animal Extends Object
    Dim As String s = "compile-time type is an 'animal'"
End Type

Type cat Extends animal
    Dim As String s = "compile-time type is a 'cat'"
End Type


Dim Byref As animal ac = *New cat()
Print "'Dim Byref As animal ac = *New cat()':"
Print "   reference ac: " & ac.s
Print
OOP_static_cast(ac, cat, rcc)
Print "'OOP_static_cast(ac, cat, rcc)':"
If @rcc = @ac Then
    Print "   reference rcc: " & rcc.s
Elseif @rcc = 0 Then
    Print "   null reference rcc (@rcc = 0)"
End If
Print
OOP_static_cast(rcc, animal, rac)
Print "'OOP_static_cast(rcc, animal, rac)':"
If @rac = @ac Then
    Print "   reference rac: " & rac.s
Elseif @rac = 0 Then
    Print "   null reference rac (@rac = 0)"
End If
Print

Delete @ac
Sleep
Output:

Code: Select all

'Dim Byref As animal ac = *New cat()':
   reference ac: compile-time type is an 'animal'

'OOP_static_cast(ac, cat, rcc)':
   reference rcc: compile-time type is a 'cat'

'OOP_static_cast(rcc, animal, rac)':
   reference rac: compile-time type is an 'animal'
Post Reply