First try at extended classes

General FreeBASIC programming questions.
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

First try at extended classes

Post by badidea »

I found a reason to have look at extended classes. Although, not for the example code below, but for something similar.

It is not as complicated as it thought is was. But 2 questions for the example code below:

1. I initially used base.constructor(...) instead of base(...) in the extended class. But the manual says it is bad. Talking about corrupt vtable pointers (not sure what that means). It is really bad? If so, why is it allowed and/or should the compiler not give a warning?

2. The explicit use of base for member access seems wise to me. Else the variables (mass and radius in this case) are like magic variables and one has to search for the declaration (could be some global variable as well). Any other (disagreeing) opinions on this?

Code: Select all

const as single PI = 4 * atn(1)

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

type solar_object
	dim as single mass 'kg
	dim as single radius 'm
	declare constructor(mass as single = -1, radius as single = -1) 
	declare sub showProperties()
end type

constructor solar_object(mass as single, radius as single)
	this.mass = mass
	this.radius = radius
end constructor

sub solar_object.showProperties()
	print "Mass: " + str(mass)
	print "Radius: " + str(radius)
end sub

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

type planet extends solar_object
	dim as string nameStr
	dim as single density 'kg/m3
	declare constructor(nameStr as string, mass as single, radius as single)
	declare sub showProperties()
end type

constructor planet(nameStr as string, mass as single, radius as single)
	base.constructor(mass, radius) '<-- or base(mass, radius) ???
	this.nameStr = nameStr
end constructor

sub planet.showProperties()
	print "Name: " + nameStr
	base.showProperties()
	dim as single volume = (4 / 3) * PI * base.radius ^ 2 'm3 
	density = base.mass / base.radius '<-- use of base to clarify where the variables are declared
	print "Density: " + str(density)
end sub

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

dim as planet earth = planet("Earth", 5.97e+24, 6.37e+6)

earth.showProperties()
I have not looked at virtual, abstract or override yet. That stuff sounds really complex :-)
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: First try at extended classes

Post by D.J.Peters »

In your "simple" example you don't need the "base" part you can access the vars directly !
(and str() is QBASIC oldschool)

Joshy

Code: Select all

sub planet.showProperties()
   print "Name   : " & nameStr
   print "Mass   : " & mass
   print "Radius : " & radius
   print "Volume : " & (4 / 3) * PI * radius * radius
   print "Density: " &  mass / radius
end sub
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: First try at extended classes

Post by D.J.Peters »

complete:

Code: Select all

const as single PI = 4 * atn(1)

type solar_object
  declare constructor(_mass as single = -1, _radius as single = -1)
  declare sub showProperties()
  as single mass 'kg
  as single radius 'm  
end type
constructor solar_object(_mass as single, _radius as single)
  mass   = _mass
  radius = _radius
end constructor
sub solar_object.showProperties()
   print "Mass: " & mass
   print "Radius: " & radius
end sub

type planet extends solar_object
   declare constructor(_nameStr as string, _mass as single, _radius as single)
   declare sub showProperties()  
   as string nameStr
   as single density
   as single volume
end type

constructor planet(_nameStr as string, _mass as single, _radius as single)
  nameStr = _nameStr
  mass    = _mass
  radius  = _radius
  density = _mass / _radius
  volume  = (4.0 / 3.0) * PI * _radius * _radius
end constructor

sub planet.showProperties()
   print "Name   : " & nameStr
   print "Mass   : " & mass
   print "Radius : " & radius
   print "Volume : " & volume 
   print "Density: " & density
end sub
'
' main
'
dim as planet earth = planet("Earth", 5.97e+24, 6.37e+6)
earth.showProperties()
sleep
fxm
Moderator
Posts: 12082
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: First try at extended classes

Post by fxm »

badidea wrote:1. I initially used base.constructor(...) instead of base(...) in the extended class. But the manual says it is bad. Talking about corrupt vtable pointers (not sure what that means). It is really bad? If so, why is it allowed and/or should the compiler not give a warning?
Indeed it's a bad habit.

- 2 examples of bad behavior in the case of constructors's chaining between child-type and parent-type:
  • Code: Select all

    Type Parent Extends Object
      Declare Virtual Sub mytype ()
      Declare Constructor ()
    End Type
    
    Sub Parent.mytype ()
      Print "I am a Parent"
    End Sub
    
    Constructor Parent ()
      Print "Parent constructor called"
    End Constructor
    
    
    Type Child1 Extends Parent
      Declare Virtual Sub mytype ()
      Declare Constructor ()
    End Type
    
    Sub Child1.mytype ()
      Print "I am a Child1"
    End Sub
    
    Constructor Child1 ()
      Base()
    End Constructor
    
    
    Type Child2 Extends Parent
      Declare Virtual Sub mytype ()
      Declare Constructor ()
    End Type
    
    Sub Child2.mytype ()
      Print "I am a Child2"
    End Sub
    
    Constructor Child2 ()
      Base.Constructor()  '' *** bad syntax *** ('Base()' is good)
    End Constructor
    
    
    Dim As Parent Ptr p1 = New Child1
    p1->mytype()
    Delete p1
    Print
    Dim As Parent Ptr p2 = New Child2
    p2->mytype()
    Delete p2
    
    Sleep
    

    Code: Select all

    Parent constructor called
    I am a Child1
    
    Parent constructor called
    Parent constructor called
    I am a Parent
    • run-time type of Child2-object overwritten by the double base-construction (the inheritance polymorphism does not work anymore)

    Code: Select all

    Type Parent
      Dim As Integer Ptr p
      Declare Constructor ()
      Declare Destructor ()
    End Type
    
    Constructor Parent ()
      Print "Parent constructor called"
      This.p = New Integer
      Print "memory allocated at @" & This.p
    End Constructor
    
    Destructor Parent ()
      Print "Parent destructor called"
      Delete This.p
      Print "memory freed at @" & This.p
    End Destructor
    
    
    Type Child1 Extends Parent
      Declare Constructor ()
    End Type
    
    Constructor Child1 ()
      Base()
    End Constructor
    
    
    Type Child2 Extends Parent
      Declare Constructor ()
    End Type
    
    Constructor Child2 ()
      Base.Constructor()  '' *** bad syntax *** ('Base()' is good)
    End Constructor
    
    
    Dim As Parent Ptr p1 = New Child1
    Delete p1
    Print
    Dim As Parent Ptr p2 = New Child2
    Delete p2
    
    Sleep
    

    Code: Select all

    Parent constructor called
    memory allocated at @5778128
    Parent destructor called
    memory freed at @5778128
    
    Parent constructor called
    memory allocated at @5778128
    Parent constructor called
    memory allocated at @5778144
    Parent destructor called
    memory freed at @5778144
    • double memory allocation then one single deallocation (inducing memory leak)
- Similarly, even inside a one single type, such constructors's bad chaining (called on an instance) can also induce bad behavior due to the double call of the composed object constructor.
By replacing the previous example of inheritance with the composition:

Code: Select all

Type UDT0
  Dim As Integer Ptr p
  Declare Constructor ()
  Declare Destructor ()
End Type

Constructor UDT0 ()
  Print "UDT0 constructor called"
  This.p = New Integer
  Print "memory allocated at @" & This.p
End Constructor

Destructor UDT0 ()
  Print "UDT0 destructor called"
  Delete This.p
  Print "memory freed at @" & This.p
End Destructor


Type UDT1
  Dim As UDT0 u0
  Declare Constructor ()
  Declare Constructor (Byval i As Integer)
End Type

Constructor UDT1 ()
End Constructor

Constructor UDT1 (Byval i As Integer)
  Constructor()
End Constructor


Type UDT2
  Dim As UDT0 u0
  Declare Constructor ()
  Declare Constructor (Byval i As Integer)
End Type

Constructor UDT2 ()
End Constructor

Constructor UDT2 (Byval i As Integer)
  This.Constructor()  '' *** bad syntax *** ('Constructor()' is good)
End Constructor


Scope
  Dim As UDT1 u = 0
End Scope
Print
Scope
  Dim As UDT2 u2 = 0
End Scope

Sleep

Code: Select all

UDT0 constructor called
memory allocated at @7678656
UDT0 destructor called
memory freed at @7678656

UDT0 constructor called
memory allocated at @7678656
UDT0 constructor called
memory allocated at @7678672
UDT0 destructor called
memory freed at @7678672
Last edited by fxm on Sep 12, 2019 12:22, edited 7 times in total.
fxm
Moderator
Posts: 12082
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: First try at extended classes

Post by fxm »

badidea wrote:2. The explicit use of base for member access seems wise to me. Else the variables (mass and radius in this case) are like magic variables and one has to search for the declaration (could be some global variable as well). Any other (disagreeing) opinions on this?
When a base field name is not hidden by a derived field of same name, the 2 syntaxes ('Base.fieldname' and 'This.fieldname') are equivalent.

My opinion:
- If you really want to take full advantage of the inheritance capability, a child object IS (also) a base object, use of 'This' is better than 'Base'.
- Reserve the use of 'Base' only in the rarest cases of name masking.
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: First try at extended classes

Post by badidea »

Thanks both, enough clarification for now.
I forgot about &, much cleaner then + str(...) indeed.
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: First try at extended classes

Post by badidea »

I have another extended class question.

Lets say I have a base class astro_object and 2 extended classes planet_type end comet_type (each with there own added properties and methods).
Next I have 2 classes containing a list planets and a list of comets: planet_list_type and comet_list_type.
All nice, but now I have method getNearest for both list classes. Which is functional identical, but I don't want to write it twice.
So I thought I make the 2 list classes extended classes of a astro_object_list class, but then I had no idea how to continue.

Any suggestions?

Code: Select all

type astro_object
	dim as single x, y 'position
	dim as single mass, radius
end type

type planet_type extends astro_object
	dim as integer numMoons
	'more properties and methods...
end type

type comet_type extends astro_object
	dim as string yearOfDiscovery 'whatever
	'more properties and methods...
end type


type astro_object_list
	dim as astro_object astroObject(any) 'array
	declare function getNearest() as integer
end type

function astro_object_list.getNearest() as integer
	dim as integer nearest = 0
	for i as integer = 1 to ubound(astroObject)
		'code to determine nearest object using x, y 
	next
	return nearest
end function

type planet_list_type
	dim as planet_type planets(any) 'array
	'declare function getNearest() as integer
end type

type comet_list_type
	dim as comet_type comets(any) 'array
	'declare function getNearest() as integer
end type
fxm
Moderator
Posts: 12082
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: First try at extended classes

Post by fxm »

I only see the following solution to factorize a little getNearest():
- from a planet_list_type instance (and from its planets() array), create a temporary instance of astro_object_list (by sizing and filling its astroObject() array), then call getNearest() on this temporary instance,
- similarly for a comet_list_type instance.

Code: Select all

type astro_object
   dim as single x, y 'position
   dim as single mass, radius
end type

type planet_type extends astro_object
   dim as integer numMoons
   'more properties and methods...
end type

type comet_type extends astro_object
   dim as string yearOfDiscovery 'whatever
   'more properties and methods...
end type


type astro_object_list
   dim as astro_object astroObject(any) 'array
   declare function getNearest() as integer
end type

function astro_object_list.getNearest() as integer
   dim as integer nearest = 0
   for i as integer = 1 to ubound(astroObject)
      'code to determine nearest object using x, y
   next
   return nearest
end function

type planet_list_type
   dim as planet_type planets(any) 'array
   declare function getNearest() as integer
end type

function planet_list_type.getNearest() as integer
   dim as integer nearest = 0
   if ubound(planets)> -1 then
      dim as astro_object_list temp_astro_object_list            '' declaring
      redim temp_astro_object_list.astroObject(ubound(planets))  '' sizing
      for i as integer = 1 to ubound(planets)                    '' filling
         temp_astro_object_list.astroObject(i) = planets(i)      '' thanks to inheritance
      next
      nearest = temp_astro_object_list.getNearest()              '' calling
   end if
   return nearest
end function

type comet_list_type
   dim as comet_type comets(any) 'array
   declare function getNearest() as integer
end type

function comet_list_type.getNearest() as integer
   dim as integer nearest = 0
   if ubound(comets) > -1 then
      dim as astro_object_list temp_astro_object_list           '' declaring
      redim temp_astro_object_list.astroObject(ubound(comets))  '' sizing
      for i as integer = 1 to ubound(comets)                    '' filling
         temp_astro_object_list.astroObject(i) = comets(i)      '' thanks to inheritance
      next
      nearest = temp_astro_object_list.getNearest()             '' calling
   end if
   return nearest
end function
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: First try at extended classes

Post by badidea »

It does not looks so nice.

I tried with a separate subroutine, but that goes wrong:

Code: Select all

type astro_object
	dim as single x, y 'position
	dim as single mass, radius
	declare constructor()
end type

constructor astro_object()
	x = 1 : y = 2 : mass = 3 : radius = 4
end constructor

type planet_type extends astro_object
	dim as integer numMoons
	'more properties and methods...
end type

type comet_type extends astro_object
	dim as string yearOfDiscovery 'whatever
	'more properties and methods...
end type

type planet_list_type
	dim as planet_type planets(any) 'array
	'declare function getNearest() as integer
end type

type comet_list_type
	dim as comet_type comets(any) 'array
	'declare function getNearest() as integer
end type

function getNearest(item() as astro_object) as integer
	for i as integer = 0 to ubound(item)
		print item(i).x, item(i).y
	next
	return 0
end function

'test code
dim as comet_list_type cometList
redim cometList.comets(0 to 2)
getNearest(cometList.comets())
fxm
Moderator
Posts: 12082
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: First try at extended classes

Post by fxm »

It 's a miss/bug of the compiler that should output an error message on:
getNearest(cometList.comets())
error 58: Type mismatch, at parameter 1 (item) of GETNEAREST() in 'getNearest(cometList.comets())'

For Jeff (developer) and the others:
A Child object IS a Parent object
But an array of Child object IS NOT an array of Parent object
  • except for:
    • - an array of 1 element set at index = 0,
      - or if the Child Type does not add data fields compared to Parent Type (if Sizeof(Child) = Sizeof(Parent))
That's why (in my previous solution) I was forced to build a temporary Parent array from the Child array, copying element by element (where the covariance applies only).
fxm
Moderator
Posts: 12082
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: First try at extended classes

Post by fxm »

@Jeff,

I am ready to fill in the bug report: "Covariance of elements of arrays does not induce the covariance of the arrays":

With 'Child' inheriting from 'Parent':
- A 'As Child' argument can be passed to a procedure expecting a 'As Parent' parameter.
- But a '() As Child' argument must not be passed to a procedure expecting a '() As Parent' parameter.

Bug example:

Code: Select all

Type Parent
  Dim As Integer I = 1
End Type

Type Child Extends Parent
  Dim As Integer J = 2
  Dim As Integer K = 3
End Type

Sub print_parent_element (Byref item As Parent)
  Print "     " & item.I;
End Sub

Sub print_parent_array (array() As Parent)
  For n As Integer = Lbound(array) To Ubound(array)
    Print "     " & array(n).I;
  Next n
  Print
End Sub

Dim As Child array(0 To 6)

For n As Integer = Lbound(array) To Ubound(array)
  print_parent_element(array(n))  '' OK (covariance)
Next n
Print
print_parent_array(array())  '' NOK (no covariance), expected 'error 58: Type mismatch, at parameter 1 ...'
Print

Sleep

Code: Select all

     1     1     1     1     1     1     1
     1     2     3     1     2     3     1
h4tt3n
Posts: 698
Joined: Oct 22, 2005 21:12
Location: Denmark

Re: First try at extended classes

Post by h4tt3n »

badidea wrote:I have another extended class question.

Lets say I have a base class astro_object and 2 extended classes planet_type end comet_type (each with there own added properties and methods).
Next I have 2 classes containing a list planets and a list of comets: planet_list_type and comet_list_type.
All nice, but now I have method getNearest for both list classes. Which is functional identical, but I don't want to write it twice.
So I thought I make the 2 list classes extended classes of a astro_object_list class, but then I had no idea how to continue.

Any suggestions?
I have solved a similar problem by defining a physical object base class and then either let planet and comet class inherit it, or add it as a component like you would any other variable. Then a function taking (a pointer to) the base object as a parameter will be able to handle any physical object you might invent during development - stars, black holes, asteroids, space ships...
fxm
Moderator
Posts: 12082
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: First try at extended classes

Post by fxm »

The difficulty comes from the fact that we want to handle an array of instances and not a single instance, so we have to calculate the actual offset between array elements according to the real Type of the elements.

A solution example, issued from the last code of badidea, by using the 'Is (RTTI)' operator:
(works because the array element of index=0 exists)

Code: Select all

type astro_object extends object
   dim as single x, y 'position
   dim as single mass, radius
   declare constructor()
end type

constructor astro_object()
   x = 1 : y = 2 : mass = 3 : radius = 4
end constructor

type planet_type extends astro_object
   dim as integer numMoons
   'more properties and methods...
end type

type comet_type extends astro_object
   dim as string yearOfDiscovery 'whatever
   'more properties and methods...
end type

type planet_list_type
   dim as planet_type planets(any) 'array
   'declare function getNearest() as integer
end type

type comet_list_type
   dim as comet_type comets(any) 'array
   'declare function getNearest() as integer
end type

function getNearest(item() as astro_object) as integer  '' works because item(0) exists
   dim as integer offset
   if item(0)is planet_type then
      offset = sizeof(planet_type)
   elseif item(0) is comet_type then
      offset = sizeof(comet_type)
   else
      offset = sizeof(astro_object)
   end if
   dim as astro_object ptr p = cast(any ptr, @item(lbound(item))) + (offset - sizeof(astro_object)) * lbound(item)
   for i as integer = lbound(item) to ubound(item)
      print p->x, p->y
      p = cast(any ptr, p) + offset
   next
   return 0
end function

'test code
dim as comet_list_type cometList
redim cometList.comets(-2 to 3)
getNearest(cometList.comets())

Code: Select all

 1             2
 1             2
 1             2
 1             2
 1             2
 1             2
But every time we want to add a new derived Type, we have to complete the 'getNearest(() as astro_object)' function.
Last edited by fxm on Sep 21, 2019 20:23, edited 2 times in total.
coderJeff
Site Admin
Posts: 4313
Joined: Nov 04, 2005 14:23
Location: Ontario, Canada
Contact:

Re: First try at extended classes

Post by coderJeff »

fxm wrote:@Jeff,

I am ready to fill in the bug report: "Covariance of elements of arrays does not induce the covariance of the arrays":
I agree, it's a bug, and should return an error message.
fxm
Moderator
Posts: 12082
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: First try at extended classes

Post by fxm »

Post Reply