Need help with implementation of variant-array

General FreeBASIC programming questions.
Tourist Trap
Posts: 2768
Joined: Jun 02, 2015 16:24

Need help with implementation of variant-array

Postby Tourist Trap » Aug 13, 2016 15:22

[edit]fxm improved version

Code: Select all

'*root*         -> TYPECAP                                         
'integer        -> INTEGERCAP                                     
'single         -> SINGLECAP                                       
'zstring_ptr    -> ZSTRINGPTRCAP                                   


type TYPECAP extends OBJECT
    declare abstract operator cast() as integer
    declare abstract operator cast() as single
    declare abstract operator cast() as string
    declare abstract function GetType() as string
    declare abstract function ToString() as string
end type
type VARIANT as TYPECAP ptr


type INTEGERCAP extends TYPECAP
    declare constructor()
    declare constructor(byval I as integer)
    declare operator let(byref as integer)
    declare virtual operator cast() as integer override
    declare virtual operator cast() as single override
    declare virtual operator cast() as string override
    declare virtual function GetType() as string override
    declare virtual function ToString() as string override
        as integer  _value
end type
constructor INTEGERCAP()
    BASE()
end constructor
constructor INTEGERCAP(byval I as integer)
   BASE()
   THIS._value => I
end constructor
operator INTEGERCAP.let(byref LetValue as integer)
    THIS._value = LetValue
end operator
operator INTEGERCAP.cast() as integer
    '---->
    return THIS._value
end operator
operator INTEGERCAP.cast() as single
    '---->
    return THIS._value
end operator
operator INTEGERCAP.cast() as string
    '---->
    return Str(THIS._value)
end operator
function INTEGERCAP.GetType() as string
    '---->
    return "integercap"
end function
function INTEGERCAP.ToString() as string
   '---->
   return str(THIS._value)
end function

type SINGLECAP extends TYPECAP
    declare constructor()
    declare constructor(byval S as single)
    declare operator let(byref as single)
    declare virtual operator cast() as integer override
    declare virtual operator cast() as single override
    declare virtual operator cast() as string override
    declare virtual function GetType() as string override
    declare virtual function ToString() as string override
        as single  _value
end type
constructor SINGLECAP()
    BASE()
end constructor
constructor SINGLECAP(byval S as single)
   BASE()
   THIS._value => S
end constructor
operator SINGLECAP.let(byref LetValue as single)
    THIS._value = LetValue
end operator
operator SINGLECAP.cast() as integer
    '---->
    return THIS._value
end operator
operator SINGLECAP.cast() as single
    '---->
    return THIS._value
end operator
operator SINGLECAP.cast() as string
    '---->
    return Str(THIS._value)
end operator
function SINGLECAP.GetType() as string
    '---->
    return "singlecap"
end function
function SINGLECAP.ToString() as string
   '---->
   return str(THIS._value)
end function

type ZSTRINGPTRCAP extends TYPECAP
    declare constructor()
    declare constructor(byval Z as zstring ptr)
    declare operator let(byref as zstring ptr)
    declare virtual operator cast() as integer override
    declare virtual operator cast() as single override
    declare virtual operator cast() as string override
    declare virtual function GetType() as string override
    declare virtual function ToString() as string override
        as zstring ptr  _value
end type
constructor ZSTRINGPTRCAP()
    BASE()
end constructor
constructor ZSTRINGPTRCAP(byval Z as zstring ptr)
    BASE()
    THIS._value => Z
end constructor
operator ZSTRINGPTRCAP.let(byref LetValue as zstring ptr)
    THIS._value = LetValue
end operator
operator ZSTRINGPTRCAP.cast() as integer
    '---->
    return Val(*THIS._value)
end operator
operator ZSTRINGPTRCAP.cast() as single
    '---->
    return Val(*THIS._value)
end operator
operator ZSTRINGPTRCAP.cast() as string
    '---->
    return *THIS._value
end operator
function ZSTRINGPTRCAP.GetType() as string
    '---->
    return "zstringptrcap"
end function
function ZSTRINGPTRCAP.ToString() as string
   '---->
   return *THIS._value
end function

'````````````````````````````````````````````````````````````````````
'define an array of variant
dim as VARIANT   arrayOfVariant(any)

'fill the array
redim arrayOfVariant(1 to 3)
arrayOfVariant(1) = @INTEGERCAP(99)
arrayOfVariant(2) = @SINGLECAP(3.1415)
arrayOfVariant(3) = @ZSTRINGPTRCAP("hello_variant")

'now you can get back the type of each variable stored as well as its value
? 1, arrayOfVariant(1)->GetType(), *arrayOfVariant(1)
? 2, arrayOfVariant(2)->GetType(), *arrayOfVariant(2)
? 3, arrayOfVariant(3)->GetType(), *arrayOfVariant(3)
?

'some operations
? "? 1+2+3", *arrayOfVariant(1) + *arrayOfVariant(2) + *arrayOfVariant(3)
? "? 1&2&3", *arrayOfVariant(1) & *arrayOfVariant(2) & *arrayOfVariant(3)
?

'other operations
? *arrayOfVariant(1) + *arrayOfVariant(2)
? *arrayOfVariant(1) & *arrayOfVariant(2)
? *arrayOfVariant(3)
?

'ToString method
? (type<INTEGERCAP>(*arrayOfVariant(2) + *arrayOfVariant(1))).ToString()
? arrayOfVariant(2)->ToString()
? arrayOfVariant(3)->ToString()

'````````````````````````````````````````````````````````````````````
getKey()

'(eof)


[edit] Corrected version of the 1st times:

Code: Select all

'testing an implementation of variant array                       

'                                ___type encapsulation____
'*root*           -> TYPECAP                                         
'integer        -> INTEGERCAP                                     
'single         -> SINGLECAP                                       
'zstring_ptr    -> ZSTRINGPTRCAP                                   


type TYPECAP extends OBJECT
    declare function GetType() as string
        as string   _typeId = "typecap"
    declare static function CommonString(byval as TYPECAP ptr) as string
end type
type VARIANT as TYPECAP
function TYPECAP.GetType() as string
    '---->
    return THIS._typeId
end function


type INTEGERCAP extends TYPECAP
    declare constructor()
    declare operator let(byref as integer)
    declare operator cast() byref as integer
    declare function ToString() as string
        as integer  _value
end type
constructor INTEGERCAP()
    BASE()
    THIS._typeId = "integercap"
end constructor
operator INTEGERCAP.let(byref LetValue as integer)
    THIS._value = LetValue
end operator
operator INTEGERCAP.cast() byref as integer
    '---->
    return THIS._value
end operator
function INTEGERCAP.ToString() as string
    '---->
    return str(THIS._value)
end function

type SINGLECAP extends TYPECAP
    declare constructor()
    declare operator let(byref as single)
    declare operator cast() byref as single
    declare function ToString() as string
        as single  _value
end type
constructor SINGLECAP()
    BASE()
    THIS._typeId = "singlecap"
end constructor
operator SINGLECAP.let(byref LetValue as single)
    THIS._value = LetValue
end operator
operator SINGLECAP.cast() byref as single
    '---->
    return THIS._value
end operator
function SINGLECAP.ToString() as string
    '---->
    return str(THIS._value)
end function

type ZSTRINGPTRCAP extends TYPECAP
    declare constructor()
    declare operator let(byref as zstring ptr)
    declare operator cast() byref as zstring ptr
    declare function ToString() as string
        as string       _id
        as zstring ptr  _value
end type
constructor ZSTRINGPTRCAP()
    BASE()
    THIS._typeId = "zstringptrcap"
end constructor
operator ZSTRINGPTRCAP.let(byref LetValue as zstring ptr)
    THIS._value = LetValue
end operator
operator ZSTRINGPTRCAP.cast() byref as zstring ptr
    '---->
    return THIS._value
end operator
function ZSTRINGPTRCAP.ToString() as string
    '---->
    return *THIS._value
end function

function TYPECAP.CommonString(byval TCPtr as TYPECAP ptr) as string
   select case uCase( TCPtr->GetType() )
      case "INTEGERCAP"
         '---->
         return cPtr(INTEGERCAP ptr, TCPtr)->ToString()
      case "SINGLECAP"
         '---->
         return cPtr(SINGLECAP ptr, TCPtr)->ToString()
      case "ZSTRINGPTRCAP"
         '---->
         return cPtr(ZSTRINGPTRCAP ptr, TCPtr)->ToString()
      case else
         '---->
         return "error"
   end select
end function

'````````````````````````````````````````````````````````````````````
'define an array of variant
dim as VARIANT ptr   arrayOfVariant(any)

'define and assign some variable of different types
dim as INTEGERCAP   i
i = 4
dim as SINGLECAP   s
s = 0.233
dim as ZSTRINGPTRCAP   z
z = @"hello"

'put the pointers of the variable in the array
redim arrayOfVariant(1 to 3)
arrayOfVariant(1) = @i
arrayOfVariant(2) = @s
arrayOfVariant(3) = @z

'now you can get back the type of each variable stored as well as its value
? 1, arrayOfVariant(1)->GetType(), "value=";
? VARIANT.CommonString(arrayOfVariant(1))

? 2, arrayOfVariant(2)->GetType(), "value=";
? VARIANT.CommonString(arrayOfVariant(2))

? 3, arrayOfVariant(3)->GetType(), "value=";
? VARIANT.CommonString(arrayOfVariant(3))


'````````````````````````````````````````````````````````````````````

getKey()

'(eof)

/*original question*/
Hi there,

I'm using some encapsulation to make some variant array. I've not really encountered any difficulty, but 2 weird things.
If I don't print the results in CommonString() procedure, I can't print it from outside... But it's all string here.
And second thing, my zstring has its value disapeared... I don't master too much zstrings so what happened?

Thanks for any help.

Code: Select all

'testing an implementation of variant array                       

'                                ___type encapsulation____
'*root*           -> TYPECAP                                         
'integer        -> INTEGERCAP                                     
'single         -> SINGLECAP                                       
'zstring_ptr    -> ZSTRINGPTRCAP                                   


type TYPECAP extends OBJECT
    declare function GetType() as string
        as string   _typeId = "typecap"
    declare static sub CommonString(byref as TYPECAP ptr)
end type
type VARIANT as TYPECAP
function TYPECAP.GetType() as string
    '---->
    return THIS._typeId
end function


type INTEGERCAP extends TYPECAP
    declare constructor()
    declare operator let(byref as integer)
    declare operator cast() byref as integer
    declare function ToString() as string
        as integer  _value
end type
constructor INTEGERCAP()
    BASE()
    THIS._typeId = "integercap"
end constructor
operator INTEGERCAP.let(byref LetValue as integer)
    THIS._value = LetValue
end operator
operator INTEGERCAP.cast() byref as integer
    '---->
    return THIS._value
end operator
function INTEGERCAP.ToString() as string
    '---->
    return str(THIS._value)
end function

type SINGLECAP extends TYPECAP
    declare constructor()
    declare operator let(byref as single)
    declare operator cast() byref as single
    declare function ToString() as string
        as single  _value
end type
constructor SINGLECAP()
    BASE()
    THIS._typeId = "singlecap"
end constructor
operator SINGLECAP.let(byref LetValue as single)
    THIS._value = LetValue
end operator
operator SINGLECAP.cast() byref as single
    '---->
    return THIS._value
end operator
function SINGLECAP.ToString() as string
    '---->
    return str(THIS._value)
end function

type ZSTRINGPTRCAP extends TYPECAP
    declare constructor()
    declare operator let(byref as zstring ptr)
    declare operator cast() byref as zstring ptr
    declare function ToString() as string
        as string       _id
        as zstring ptr  _value
end type
constructor ZSTRINGPTRCAP()
    BASE()
    THIS._typeId = "zstringcap"
end constructor
operator ZSTRINGPTRCAP.let(byref LetValue as zstring ptr)
    THIS._value = LetValue
end operator
operator ZSTRINGPTRCAP.cast() byref as zstring ptr
    '---->
    return THIS._value
end operator
function ZSTRINGPTRCAP.ToString() as string
    '---->
    return *THIS._value
end function


sub TYPECAP.CommonString(byref TCPtr as TYPECAP ptr)
   select case uCase( TCPtr->GetType() )
      case "INTEGERCAP"
         ? cPtr(INTEGERCAP ptr, TCPtr)->ToString()
      case "SINGLECAP"
         ? cPtr(SINGLECAP ptr, TCPtr)->ToString()
      case "ZSTRINGPTRCAP"
         ? cPtr(ZSTRINGPTRCAP ptr, TCPtr)->ToString()
   end select
end sub

'````````````````````````````````````````````````````````````````````
'define an array of variant
dim as VARIANT ptr   arrayOfVariant(any)

'define and assign some variable of different types
dim as INTEGERCAP   i
i = 4
dim as SINGLECAP   s
s = 0.233
dim as ZSTRINGPTRCAP   z
z = @"hello"

'put the pointers of the variable in the array
redim arrayOfVariant(1 to 3)
arrayOfVariant(1) = @i
arrayOfVariant(2) = @s
arrayOfVariant(3) = @z

'now you can get back the type of each variable stored as well as its value
? 1, arrayOfVariant(1)->GetType(), "value=";
arrayOfVariant(1)->CommonString(arrayOfVariant(1))
'!!!ISSUE A!!!
'? arrayOfVariant(1)->CommonString(arrayOfVariant(1))  '' error 17: Syntax error in '? TYPECAP.CommonString( (arrayOfVariant(1)) )

? 2, arrayOfVariant(2)->GetType(), "value=";
arrayOfVariant(2)->CommonString(arrayOfVariant(2))

? 3, arrayOfVariant(3)->GetType(), "value=";
VARIANT.CommonString(arrayOfVariant(3))
'!!!ISSUE B!!! where's my value??


'````````````````````````````````````````````````````````````````````

getKey()

'(eof)
Last edited by Tourist Trap on Aug 30, 2016 22:19, edited 3 times in total.
fxm
Posts: 9315
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Need help with implementation of variant-array

Postby fxm » Aug 13, 2016 16:13

- Issue A:
CommonString() is not a function but a sub.
There is no result for printing.

- Issue B:

Code: Select all

constructor ZSTRINGPTRCAP()
    BASE()
    THIS._typeId = "zstringptrcap"
end constructor
Tourist Trap
Posts: 2768
Joined: Jun 02, 2015 16:24

Re: Need help with implementation of variant-array

Postby Tourist Trap » Aug 13, 2016 17:11

Thanks.

For the function, I was probably troubled due to the disorder (forward stuff)...

fxm wrote:- Issue B:

Code: Select all

constructor ZSTRINGPTRCAP()
    BASE()
    THIS._typeId = "zstringptrcap"
end constructor

About this I don't understand, this is _value that hold the zstring ptr. If I do print *z._value, there is no problem. And the method ToString() just do that, but in the function then nothing appears.

Ok I've found it, it was a typo in the type id name... Thanks again.
Tourist Trap
Posts: 2768
Joined: Jun 02, 2015 16:24

Re: Need help with implementation of variant-array

Postby Tourist Trap » Aug 30, 2016 8:06

I've looked again at this affair of variant and found many issues.
I can't retrieve the value automatically whatever I do(without asking the user to cast and to know the type of the value of the variant).
I've looked at the MOD implementation of VARIANT, and apparently there neither, in its "select case example" it does a cast outside the variant logic -> up to the user to solve the variant into the right type.
The implementation of MOD is tremendous because of the resulting construction syntax like : "Dim zahl As Variant = 5". But it does :

Code: Select all

Dim text As Variant = "bar"
Select Case    Cast(String, text)
'....

And this is this cast that I want to avoid. This is like asking the user to know the type of the value stored in the variant, or he wont be able to use it. I would prefer the variant logic to solve this issue even in an uggly way.
I have tried to use typeof on the value, but it is not possible to get the string, it goes to the IDE output...
I have also tried to use an IIF bloc and a macro, but IIF can't have two different resulting types. This is quite annoying.

Would anyone have an idea? Or to use correctly IIF or TypeOf, or to do differently ? Thanks.

Code: Select all

'*root*           -> TYPECAP                                         
'integer        -> INTEGERCAP                                     
'single         -> SINGLECAP                                       
'zstring_ptr    -> ZSTRINGPTRCAP                                   


type TYPECAP extends OBJECT
    declare function GetType() as string
        as string   _typeId = "typecap"
    declare static function CommonString(byval as TYPECAP ptr) as string
end type
type VARIANT as TYPECAP
function TYPECAP.GetType() as string
    '---->
    return THIS._typeId
end function


type INTEGERCAP extends TYPECAP
    declare constructor()
    declare operator let(byref as integer)
    declare operator cast() byref as integer
    declare function ToString() as string
        as integer  _value
end type
constructor INTEGERCAP()
    BASE()
    THIS._typeId = "integercap"
end constructor
operator INTEGERCAP.let(byref LetValue as integer)
    THIS._value = LetValue
end operator
operator INTEGERCAP.cast() byref as integer
    '---->
    return THIS._value
end operator
function INTEGERCAP.ToString() as string
    '---->
    return str(THIS._value)
end function

type SINGLECAP extends TYPECAP
    declare constructor()
    declare operator let(byref as single)
    declare operator cast() byref as single
    declare function ToString() as string
        as single  _value
end type
constructor SINGLECAP()
    BASE()
    THIS._typeId = "singlecap"
end constructor
operator SINGLECAP.let(byref LetValue as single)
    THIS._value = LetValue
end operator
operator SINGLECAP.cast() byref as single
    '---->
    return THIS._value
end operator
function SINGLECAP.ToString() as string
    '---->
    return str(THIS._value)
end function

type ZSTRINGPTRCAP extends TYPECAP
    declare constructor()
    declare operator let(byref as zstring ptr)
    declare operator cast() byref as zstring ptr
    declare function ToString() as string
        as string       _id
        as zstring ptr  _value
end type
constructor ZSTRINGPTRCAP()
    BASE()
    THIS._typeId = "zstringptrcap"
end constructor
operator ZSTRINGPTRCAP.let(byref LetValue as zstring ptr)
    THIS._value = LetValue
end operator
operator ZSTRINGPTRCAP.cast() byref as zstring ptr
    '---->
    return THIS._value
end operator
function ZSTRINGPTRCAP.ToString() as string
    '---->
    return *THIS._value
end function

function TYPECAP.CommonString(byval TCPtr as TYPECAP ptr) as string
   select case uCase( TCPtr->GetType() )
      case "INTEGERCAP"
         '---->
         return ( uCase( TCPtr->GetType() ) &":"& cPtr(INTEGERCAP ptr, TCPtr)->ToString() )
      case "SINGLECAP"
         '---->
         return ( uCase( TCPtr->GetType() ) &":"& cPtr(SINGLECAP ptr, TCPtr)->ToString() )
      case "ZSTRINGPTRCAP"
         '---->
         return ( uCase( TCPtr->GetType() ) &":"& cPtr(ZSTRINGPTRCAP ptr, TCPtr)->ToString() )
      case else
         '---->
         return ( uCase( TCPtr->GetType() ) &":"& "nothing" )
   end select
end function


#macro _SOLVECOMMONSTRING(comstr)
   iif(left(comstr, instr(comstr, ":") - 1)="ZSTRINGCAP", _
       (right(comstr, len((comstr)) - instr(comstr, ":"))), _
       iif(left(comstr, instr(comstr, ":") - 1)="SINGLECAP", _
          cSng(right(comstr, len((comstr)) - instr(comstr, ":"))), _
          iif(left(comstr, instr(comstr, ":") - 1)="INTEGERCAP", _
             cInt(right(comstr, len((comstr)) - instr(comstr, ":"))), _
             "nothing"))
#endMacro




'````````````````````````````````````````````````````````````````````
'define an array of variant
dim as VARIANT ptr   arrayOfVariant(any)

'define and assign some variable of different types
dim as INTEGERCAP   i
i = 4
dim as SINGLECAP   s
s = 0.233
dim as ZSTRINGPTRCAP   z
z = @"hello"

'put the pointers of the variable in the array
redim arrayOfVariant(1 to 3)
arrayOfVariant(1) = @i
arrayOfVariant(2) = @s
arrayOfVariant(3) = @z

'now you can get back the type of each variable stored
'as well as a string representing its value but not reusable as it
? 1, arrayOfVariant(1)->GetType(), "value=";
? VARIANT.CommonString(arrayOfVariant(1))
? 2, arrayOfVariant(2)->GetType(), "value=";
? VARIANT.CommonString(arrayOfVariant(2))
? 3, arrayOfVariant(3)->GetType(), "value=";
? VARIANT.CommonString(arrayOfVariant(3))


'? _SOLVECOMMONSTRING(VARIANT.CommonString(arrayOfVariant(3)))
'error 24: Invalid data types, before ')' in '? _SOLVECOMMONSTRING(VARIANT.CommonString(arrayOfVariant(3)))'

'dim as string   tstr = (typeOf(z._value))
'error 9: Expected expression, found 'typeOf' in 'dim as string   tstr = (typeOf(z._value))'



'````````````````````````````````````````````````````````````````````

getKey()

'(eof)

I've also tried to use virtuality on ToString method but it just didn't work. The call was always done at base level for some reason.
fxm
Posts: 9315
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Need help with implementation of variant-array

Postby fxm » Aug 30, 2016 9:03

Version with dynamic polymorphism (inheritance + virtuality):

Code: Select all

'*root*         -> TYPECAP                                         
'integer        -> INTEGERCAP                                     
'single         -> SINGLECAP                                       
'zstring_ptr    -> ZSTRINGPTRCAP                                   


type TYPECAP extends OBJECT
    declare abstract function ToString() as string
    declare abstract function GetType() as string
    declare abstract function CommonString() as string
end type
type VARIANT as TYPECAP


type INTEGERCAP extends TYPECAP
    declare constructor()
    declare operator let(byref as integer)
    declare operator cast() byref as integer
    declare virtual function ToString() as string override
    declare virtual function GetType() as string override
    declare virtual function CommonString() as string override
        as integer  _value
end type
constructor INTEGERCAP()
    BASE()
end constructor
operator INTEGERCAP.let(byref LetValue as integer)
    THIS._value = LetValue
end operator
operator INTEGERCAP.cast() byref as integer
    '---->
    return THIS._value
end operator
function INTEGERCAP.ToString() as string
    '---->
    return str(THIS._value)
end function
function INTEGERCAP.GetType() as string
    '---->
    return "integercap"
end function
function INTEGERCAP.CommonString() as string
    '---->
    return ( uCase( This.GetType() ) &":"& This.ToString() )
end function

type SINGLECAP extends TYPECAP
    declare constructor()
    declare operator let(byref as single)
    declare operator cast() byref as single
    declare virtual function ToString() as string override
    declare virtual function GetType() as string override
    declare virtual function CommonString() as string override
        as single  _value
end type
constructor SINGLECAP()
    BASE()
end constructor
operator SINGLECAP.let(byref LetValue as single)
    THIS._value = LetValue
end operator
operator SINGLECAP.cast() byref as single
    '---->
    return THIS._value
end operator
function SINGLECAP.ToString() as string
    '---->
    return str(THIS._value)
end function
function SINGLECAP.GetType() as string
    '---->
    return "singlecap"
end function
function SINGLECAP.CommonString() as string
    '---->
    return ( uCase( This.GetType() ) &":"& This.ToString() )
end function

type ZSTRINGPTRCAP extends TYPECAP
    declare constructor()
    declare operator let(byref as zstring ptr)
    declare operator cast() byref as zstring ptr
    declare virtual function ToString() as string override
    declare virtual function GetType() as string override
    declare virtual function CommonString() as string override
        as zstring ptr  _value
end type
constructor ZSTRINGPTRCAP()
    BASE()
end constructor
operator ZSTRINGPTRCAP.let(byref LetValue as zstring ptr)
    THIS._value = LetValue
end operator
operator ZSTRINGPTRCAP.cast() byref as zstring ptr
    '---->
    return THIS._value
end operator
function ZSTRINGPTRCAP.ToString() as string
    '---->
    return *THIS._value
end function
function ZSTRINGPTRCAP.GetType() as string
    '---->
    return "zstringptrcap"
end function
function ZSTRINGPTRCAP.CommonString() as string
    '---->
    return ( uCase( This.GetType() ) &":"& This.ToString() )
end function



'````````````````````````````````````````````````````````````````````
'define an array of variant
dim as VARIANT ptr   arrayOfVariant(any)

'define and assign some variable of different types
dim as INTEGERCAP   i
i = 4
dim as SINGLECAP   s
s = 0.233
dim as ZSTRINGPTRCAP   z
z = @"hello"

'put the pointers of the variable in the array
redim arrayOfVariant(1 to 3)
arrayOfVariant(1) = @i
arrayOfVariant(2) = @s
arrayOfVariant(3) = @z

'now you can get back the type of each variable stored as well as its value
? 1, arrayOfVariant(1)->GetType(), arrayOfVariant(1)->ToString(), "value=";
? arrayOfVariant(1)->CommonString()

? 2, arrayOfVariant(2)->GetType(), arrayOfVariant(2)->ToString(), "value=";
? arrayOfVariant(2)->CommonString()

? 3, arrayOfVariant(3)->GetType(), arrayOfVariant(3)->ToString(), "value=";
? arrayOfVariant(3)->CommonString()

'````````````````````````````````````````````````````````````````````

getKey()

'(eof)
To check whether a procedure well overrides a base procedure, you can declare this first one with the attribute "Override", which will add a parser check during compilation.
Last edited by fxm on Aug 30, 2016 14:09, edited 1 time in total.
MOD
Posts: 555
Joined: Jun 11, 2009 20:15

Re: Need help with implementation of variant-array

Postby MOD » Aug 30, 2016 12:01

The reason my Variant works this way is, that at the time I wrote it, there was no Extends keyword and everything related to it. Furthermore you cannot overload the Select Case statement for your own datatypes, it always demands a FB primitive datatype and doesn't trigger the overloaded Cast As "whatever over primitive datatype" operator. So the Cast is necessary at this point. :\
Tourist Trap
Posts: 2768
Joined: Jun 02, 2015 16:24

Re: Need help with implementation of variant-array

Postby Tourist Trap » Aug 30, 2016 18:14

fxm wrote:Version with dynamic polymorphism (inheritance + virtuality)

This is a very nice illustration of virtuality. Thanks for this piece of code. But my issue is more specifically to access the field named "_value", which has a type that depends on the initial type recorded in the array (like SINGLECAP that has a single as _value).
I have no difficulty with the type, and the ToString in itself. It's just that I can't use the informations that I can embed in a string to extract automatically the value. Otherwise, CommonString() procedure has no real use, it's more a helper to show a result.

MOD wrote:The reason my Variant works this way is, that at the time I wrote it, there was no Extends keyword and everything related to it. Furthermore you cannot overload the Select Case statement for your own datatypes, it always demands a FB primitive datatype and doesn't trigger the overloaded Cast As "whatever over primitive datatype" operator. So the Cast is necessary at this point. :\

I like your version. It's an incredible work to make it do all the operators transparently.
Do you think that casting can be avoided? I mean, is there a way to do

Code: Select all

ArrayOfVariant(index1) + ArrayOfVariant(index2)

And to get the result casted to a numeric type if those items are both numeric. So the coder has not for instance to write:

Code: Select all

Cast(Integer, ArrayOfVariant(index1)) + Cast(Double, ArrayOfVariant(index2))
fxm
Posts: 9315
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Need help with implementation of variant-array

Postby fxm » Aug 30, 2016 21:21

Code: Select all

'*root*         -> TYPECAP                                         
'integer        -> INTEGERCAP                                     
'single         -> SINGLECAP                                       
'zstring_ptr    -> ZSTRINGPTRCAP                                   


type TYPECAP extends OBJECT
    declare abstract operator cast() as integer
    declare abstract operator cast() as single
    declare abstract operator cast() as string
    declare abstract function GetType() as string
end type
type VARIANT as TYPECAP


type INTEGERCAP extends TYPECAP
    declare constructor()
    declare operator let(byref as integer)
    declare virtual operator cast() as integer override
    declare virtual operator cast() as single override
    declare virtual operator cast() as string override
    declare virtual function GetType() as string override
        as integer  _value
end type
constructor INTEGERCAP()
    BASE()
end constructor
operator INTEGERCAP.let(byref LetValue as integer)
    THIS._value = LetValue
end operator
operator INTEGERCAP.cast() as integer
    '---->
    return THIS._value
end operator
operator INTEGERCAP.cast() as single
    '---->
    return THIS._value
end operator
operator INTEGERCAP.cast() as string
    '---->
    return Str(THIS._value)
end operator
function INTEGERCAP.GetType() as string
    '---->
    return "integercap"
end function

type SINGLECAP extends TYPECAP
    declare constructor()
    declare operator let(byref as single)
    declare virtual operator cast() as integer override
    declare virtual operator cast() as single override
    declare virtual operator cast() as string override
    declare virtual function GetType() as string override
        as single  _value
end type
constructor SINGLECAP()
    BASE()
end constructor
operator SINGLECAP.let(byref LetValue as single)
    THIS._value = LetValue
end operator
operator SINGLECAP.cast() as integer
    '---->
    return THIS._value
end operator
operator SINGLECAP.cast() as single
    '---->
    return THIS._value
end operator
operator SINGLECAP.cast() as string
    '---->
    return Str(THIS._value)
end operator
function SINGLECAP.GetType() as string
    '---->
    return "singlecap"
end function

type ZSTRINGPTRCAP extends TYPECAP
    declare constructor()
    declare operator let(byref as zstring ptr)
    declare virtual operator cast() as integer override
    declare virtual operator cast() as single override
    declare virtual operator cast() as string override
    declare virtual function GetType() as string override
        as zstring ptr  _value
end type
constructor ZSTRINGPTRCAP()
    BASE()
end constructor
operator ZSTRINGPTRCAP.let(byref LetValue as zstring ptr)
    THIS._value = LetValue
end operator
operator ZSTRINGPTRCAP.cast() as integer
    '---->
    return Val(*THIS._value)
end operator
operator ZSTRINGPTRCAP.cast() as single
    '---->
    return Val(*THIS._value)
end operator
operator ZSTRINGPTRCAP.cast() as string
    '---->
    return *THIS._value
end operator
function ZSTRINGPTRCAP.GetType() as string
    '---->
    return "zstringptrcap"
end function



'````````````````````````````````````````````````````````````````````
'define an array of variant
dim as VARIANT ptr   arrayOfVariant(any)

'define and assign some variable of different types
dim as INTEGERCAP   i
i = 4
dim as SINGLECAP   s
s = 0.233
dim as ZSTRINGPTRCAP   z
z = @"hello"

'put the pointers of the variable in the array
redim arrayOfVariant(1 to 3)
arrayOfVariant(1) = @i
arrayOfVariant(2) = @s
arrayOfVariant(3) = @z

'now you can get back the type of each variable stored as well as its value
? 1, arrayOfVariant(1)->GetType(), *arrayOfVariant(1)
? 2, arrayOfVariant(2)->GetType(), *arrayOfVariant(2)
? 3, arrayOfVariant(3)->GetType(), *arrayOfVariant(3)
?

? "? 1+2+3", *arrayOfVariant(1) + *arrayOfVariant(2) + *arrayOfVariant(3)
? "? 1&2&3", *arrayOfVariant(1) & *arrayOfVariant(2) & *arrayOfVariant(3)
?

dim as double d0 = *arrayOfVariant(1) + *arrayOfVariant(2)
? "? double(1+2)", d0
dim as string s0 = *arrayOfVariant(1) & *arrayOfVariant(2)
? "? string(1&2)", s0
dim as string s1 = *arrayOfVariant(3)
? "? string(3)", s1

'````````````````````````````````````````````````````````````````````

getKey()

'(eof)
Tourist Trap
Posts: 2768
Joined: Jun 02, 2015 16:24

Re: Need help with implementation of variant-array

Postby Tourist Trap » Aug 30, 2016 22:03

Oups I've erased my previous post. Nevermind:
@fxm, that works quite well ! Thanks a lot .
It's something that I wouldn't have found myself. It's very clever.

I don't know but looks like a possible bug at line 206. Normally I should be able to use the syntax of line 206 (TYPE<T>(...)) or 207 (T(...)) equally; but the first one is broken (since I've added abstract properties).

Code: Select all

'*root*         -> TYPECAP                                         
'integer        -> INTEGERCAP                                     
'single         -> SINGLECAP                                       
'zstring_ptr    -> ZSTRINGPTRCAP                                   


type TYPECAP extends OBJECT
    declare abstract operator cast() as integer
    declare abstract operator cast() as single
    declare abstract operator cast() as string
    declare abstract property MinValue() as integer
    declare abstract property MaxValue() as integer
    declare abstract property ClosestToZeroValue() as single
    declare abstract property ClosestToInfValue() as single
    declare abstract function GetType() as string
    declare abstract function ToString() as string
end type
type VARIANT as TYPECAP ptr


type INTEGERCAP extends TYPECAP
    declare constructor()
    declare constructor(byval I as integer)
    declare virtual property MinValue() as integer override
    declare virtual property MaxValue() as integer override
    declare operator let(byref as integer)
    declare virtual operator cast() as integer override
    declare virtual operator cast() as single override
    declare virtual operator cast() as string override
    declare virtual function GetType() as string override
    declare virtual function ToString() as string override
        as integer  _value
end type
constructor INTEGERCAP()
    BASE()
end constructor
constructor INTEGERCAP(byval I as integer)
   BASE()
   THIS._value => I
end constructor
property INTEGERCAP.MinValue() as integer
   #if __FB_64BIT__
       dim as integer min => &H8000000000000000
   #else
       dim as integer min => &H80000000
   #endif
   '---->
   return min
end property
property INTEGERCAP.MaxValue() as integer
   #if __FB_64BIT__
       dim as integer max => &H7FFFFFFFFFFFFFFF
   #else
       dim as integer max => &H7FFFFFFF
   #endif
   '---->
   return max
end property
operator INTEGERCAP.let(byref LetValue as integer)
    THIS._value = LetValue
end operator
operator INTEGERCAP.cast() as integer
    '---->
    return THIS._value
end operator
operator INTEGERCAP.cast() as single
    '---->
    return THIS._value
end operator
operator INTEGERCAP.cast() as string
    '---->
    return Str(THIS._value)
end operator
function INTEGERCAP.GetType() as string
    '---->
    return "integercap"
end function
function INTEGERCAP.ToString() as string
   '---->
   return str(THIS._value)
end function

type SINGLECAP extends TYPECAP
    declare constructor()
    declare constructor(byval S as single)
    declare virtual property ClosestToZeroValue() as single override
    declare virtual property ClosestToInfValue() as single override
    declare operator let(byref as single)
    declare virtual operator cast() as integer override
    declare virtual operator cast() as single override
    declare virtual operator cast() as string override
    declare virtual function GetType() as string override
    declare virtual function ToString() as string override
        as single  _value
end type
constructor SINGLECAP()
    BASE()
end constructor
constructor SINGLECAP(byval S as single)
   BASE()
   THIS._value => S
end constructor
property SINGLECAP.ClosestToZeroValue() as single
   '---->
   return 1.401298e-45
end property
property SINGLECAP.ClosestToInfValue() as single
   '---->
   return 3.402823e+38
end property
operator SINGLECAP.let(byref LetValue as single)
    THIS._value = LetValue
end operator
operator SINGLECAP.cast() as integer
    '---->
    return THIS._value
end operator
operator SINGLECAP.cast() as single
    '---->
    return THIS._value
end operator
operator SINGLECAP.cast() as string
    '---->
    return Str(THIS._value)
end operator
function SINGLECAP.GetType() as string
    '---->
    return "singlecap"
end function
function SINGLECAP.ToString() as string
   '---->
   return str(THIS._value)
end function

type ZSTRINGPTRCAP extends TYPECAP
    declare constructor()
    declare constructor(byval Z as zstring ptr)
    declare operator let(byref as zstring ptr)
    declare virtual operator cast() as integer override
    declare virtual operator cast() as single override
    declare virtual operator cast() as string override
    declare virtual function GetType() as string override
    declare virtual function ToString() as string override
        as zstring ptr  _value
end type
constructor ZSTRINGPTRCAP()
    BASE()
end constructor
constructor ZSTRINGPTRCAP(byval Z as zstring ptr)
    BASE()
    THIS._value => Z
end constructor
operator ZSTRINGPTRCAP.let(byref LetValue as zstring ptr)
    THIS._value = LetValue
end operator
operator ZSTRINGPTRCAP.cast() as integer
    '---->
    return Val(*THIS._value)
end operator
operator ZSTRINGPTRCAP.cast() as single
    '---->
    return Val(*THIS._value)
end operator
operator ZSTRINGPTRCAP.cast() as string
    '---->
    return *THIS._value
end operator
function ZSTRINGPTRCAP.GetType() as string
    '---->
    return "zstringptrcap"
end function
function ZSTRINGPTRCAP.ToString() as string
   '---->
   return *THIS._value
end function

'````````````````````````````````````````````````````````````````````
'define an array of variant
dim as VARIANT   arrayOfVariant(any)

'fill the array
redim arrayOfVariant(1 to 3)
arrayOfVariant(1) = @INTEGERCAP(99)
arrayOfVariant(2) = @SINGLECAP(3.1415)
arrayOfVariant(3) = @ZSTRINGPTRCAP("hello_variant")

'now you can get back the type of each variable stored as well as its value
? 1, arrayOfVariant(1)->GetType(), *arrayOfVariant(1)
? 2, arrayOfVariant(2)->GetType(), *arrayOfVariant(2)
? 3, arrayOfVariant(3)->GetType(), *arrayOfVariant(3)
?

'some operations
? "? 1+2+3", *arrayOfVariant(1) + *arrayOfVariant(2) + *arrayOfVariant(3)
? "? 1&2&3", *arrayOfVariant(1) & *arrayOfVariant(2) & *arrayOfVariant(3)
?

'other operations
? *arrayOfVariant(1) + *arrayOfVariant(2)
? *arrayOfVariant(1) & *arrayOfVariant(2)
? *arrayOfVariant(3)
?


'ToString method
? (type<SINGLECAP>(*arrayOfVariant(2) + *arrayOfVariant(1))).ToString() ''error 305: UDT has unimplemented abstract methods
? (SINGLECAP(*arrayOfVariant(2) + *arrayOfVariant(1))).ToString()      ''OK


? arrayOfVariant(2)->ToString()
? arrayOfVariant(3)->ToString()

? arrayOfVariant(2)->ClosestToZeroValue

'````````````````````````````````````````````````````````````````````
getKey()

'(eof)
fxm
Posts: 9315
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Need help with implementation of variant-array

Postby fxm » Aug 31, 2016 8:03

@dkl,

The syntax "UDT()" accepts to create a temporary object of a type "UDT" that does not implement an abstract method!

(The syntax "Type<UDT>()" refuses this as normally expected)

Code: Select all

Type Parent Extends Object
  Dim As Integer I = 123456789
  Declare Abstract Sub s ()
End Type

Type Child Extends Parent
End Type

'Dim As Parent p                      '' OK   error 305: UDT has unimplemented abstract methods
'Dim As Parent Ptr pp = New Parent()  '' OK   error 305: UDT has unimplemented abstract methods
'Print Type<Parent>().I               '' OK   error 305: UDT has unimplemented abstract methods
Print Parent().I                      '' ?

'Dim As Child c                     '' OK   error 305: UDT has unimplemented abstract methods
'Dim As Child Ptr pc = New Child()  '' OK   error 305: UDT has unimplemented abstract methods
'Print Type<Child>().I              '' OK   error 305: UDT has unimplemented abstract methods
Print Child().I                     '' ?

Sleep

Code: Select all

 123456789
 123456789

Is there an explanation that justifies this as normal?
Last edited by fxm on Sep 01, 2016 8:56, edited 3 times in total.
fxm
Posts: 9315
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Need help with implementation of variant-array

Postby fxm » Aug 31, 2016 8:16

@Tourist Trap,

1) See my above post about your remark:
for me, the both syntax types should be forbidden.

2) Otherwise, about your code:

Code: Select all

'fill the array
redim arrayOfVariant(1 to 3)
arrayOfVariant(1) = @INTEGERCAP(99)
arrayOfVariant(2) = @SINGLECAP(3.1415)
arrayOfVariant(3) = @ZSTRINGPTRCAP("hello_variant")
for me, your program is unsafe because you memorize the addresses of temporary objects (syntax "ptr = @UDT()"), while these objects are destroyed at the following line of code (so the allocated memory may have been reused).

Example of such bad codding:

Code: Select all

Type UDT
  Declare Destructor ()
  Dim As Integer I = 123456789
  Dim As String S = "FreeBASIC"
End Type
Destructor UDT ()
  Print "UDT.Destructor()"
End Destructor

Dim As UDT Ptr pu = @UDT()
Print pu->I
Print "'" & pu->S & "'"

Sleep

Code: Select all

UDT.Destructor()
 123456789
''
Tourist Trap
Posts: 2768
Joined: Jun 02, 2015 16:24

Re: Need help with implementation of variant-array

Postby Tourist Trap » Aug 31, 2016 8:31

fxm wrote:- Otherwise, about your code:

Code: Select all

'fill the array
redim arrayOfVariant(1 to 3)
arrayOfVariant(1) = @INTEGERCAP(99)
arrayOfVariant(2) = @SINGLECAP(3.1415)
arrayOfVariant(3) = @ZSTRINGPTRCAP("hello_variant")
for me, your program is unsafe because you memorize the addresses of temporary objects (syntax "ptr = @UDT()"), while these objects are destroyed at the following line of code.

I fail to put directly a value if I remove the pointers everywhere (as in the definition of VARIANT). I was able to do that before, but since your changes I can't do it anymore or more precisely as it uses advanced things I don't see why it is stuck at all.
Here an example where I could assign everything as value in the old style implementation:

Code: Select all

''variant is not pointer here

type TYPECAP extends OBJECT
    declare function GetType() as string
        as string   _typeId = "typecap"
    declare static function CommonString(byval as TYPECAP ptr) as string
end type
type VARIANT as TYPECAP
function TYPECAP.GetType() as string
    '---->
    return THIS._typeId
end function


type INTEGERCAP extends TYPECAP
    declare constructor()
    declare constructor(byval I as integer)
    declare operator let(byref as integer)
    declare operator cast() byref as integer
    declare function ToString() as string
        as integer  _value
end type
constructor INTEGERCAP()
    BASE()
    THIS._typeId = "integercap"
end constructor
constructor INTEGERCAP(byval I as integer)
    BASE()
    THIS._typeId   = "integercap"
    THIS._value      = I
end constructor
operator INTEGERCAP.let(byref LetValue as integer)
    THIS._value = LetValue
end operator
operator INTEGERCAP.cast() byref as integer
    '---->
    return THIS._value
end operator
function INTEGERCAP.ToString() as string
    '---->
    return str(THIS._value)
end function

type SINGLECAP extends TYPECAP
    declare constructor()
    declare constructor(byval S as single)
    declare operator let(byref as single)
    declare operator cast() byref as single
    declare function ToString() as string
        as single  _value
end type
constructor SINGLECAP()
    BASE()
    THIS._typeId = "singlecap"
end constructor
constructor SINGLECAP(byval S as single)
    BASE()
    THIS._typeId   = "singlecap"
    THIS._value      = S
end constructor
operator SINGLECAP.let(byref LetValue as single)
    THIS._value = LetValue
end operator
operator SINGLECAP.cast() byref as single
    '---->
    return THIS._value
end operator
function SINGLECAP.ToString() as string
    '---->
    return str(THIS._value)
end function

type ZSTRINGPTRCAP extends TYPECAP
    declare constructor()
    declare constructor(byval Z as zstring ptr)
    declare operator let(byref as zstring ptr)
    declare operator cast() byref as zstring ptr
    declare function ToString() as string
        as string       _id
        as zstring ptr  _value
end type
constructor ZSTRINGPTRCAP()
    BASE()
    THIS._typeId = "zstringptrcap"
end constructor
constructor ZSTRINGPTRCAP(byval Z as zstring ptr)
    BASE()
    THIS._typeId   = "zstringptrcap"
    THIS._value      = Z
end constructor
operator ZSTRINGPTRCAP.let(byref LetValue as zstring ptr)
    THIS._value = LetValue
end operator
operator ZSTRINGPTRCAP.cast() byref as zstring ptr
    '---->
    return THIS._value
end operator
function ZSTRINGPTRCAP.ToString() as string
    '---->
    return *THIS._value
end function

function TYPECAP.CommonString(byval TCPtr as TYPECAP ptr) as string
   select case uCase( TCPtr->GetType() )
      case "INTEGERCAP"
         '---->
         return cPtr(INTEGERCAP ptr, TCPtr)->ToString()
      case "SINGLECAP"
         '---->
         return cPtr(SINGLECAP ptr, TCPtr)->ToString()
      case "ZSTRINGPTRCAP"
         '---->
         return cPtr(ZSTRINGPTRCAP ptr, TCPtr)->ToString()
      case else
         '---->
         return "error"
   end select
end function

'````````````````````````````````````````````````````````````````````
'define an array of variant
dim as VARIANT   arrayOfVariant(any)


'put the values of the variable in the array
redim arrayOfVariant(1 to 3)
arrayOfVariant(1) = type<INTEGERCAP>(444)
arrayOfVariant(2) = type<SINGLECAP>(-9.123)
arrayOfVariant(3) = type<ZSTRINGPTRCAP>(@"hello")


? 1, arrayOfVariant(1).GetType()
? 2, arrayOfVariant(2).GetType()
? 3, arrayOfVariant(3).GetType()


'````````````````````````````````````````````````````````````````````

getKey()

'(eof)
fxm
Posts: 9315
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Need help with implementation of variant-array

Postby fxm » Aug 31, 2016 8:49

Does not work (obviously the string fields are destroyed before use):

Code: Select all

'````````````````````````````````````````````````````````````````````
'define an array of variant ptr
dim as VARIANT ptr  arrayOfVariantPtr(any)


'put the values of the variable in the array
redim arrayOfVariantPtr(1 to 3)
arrayOfVariantPtr(1) = @type<INTEGERCAP>(444)
arrayOfVariantPtr(2) = @type<SINGLECAP>(-9.123)
arrayOfVariantPtr(3) = @type<ZSTRINGPTRCAP>(@"hello")


? 1, arrayOfVariantPtr(1)->GetType()
? 2, arrayOfVariantPtr(2)->GetType()
? 3, arrayOfVariantPtr(3)->GetType()


'````````````````````````````````````````````````````````````````````

getKey()

'(eof)

Works:

Code: Select all

'````````````````````````````````````````````````````````````````````
'define an array of variant ptr
dim as VARIANT ptr  arrayOfVariantPtr(any)


'put the values of the variable in the array
redim arrayOfVariantPtr(1 to 3)
arrayOfVariantPtr(1) = new INTEGERCAP(444)
arrayOfVariantPtr(2) = new SINGLECAP(-9.123)
arrayOfVariantPtr(3) = new ZSTRINGPTRCAP(@"hello")


? 1, arrayOfVariantPtr(1)->GetType()
? 2, arrayOfVariantPtr(2)->GetType()
? 3, arrayOfVariantPtr(3)->GetType()


'````````````````````````````````````````````````````````````````````

getKey()
delete arrayOfVariantPtr(1)
delete arrayOfVariantPtr(2)
delete arrayOfVariantPtr(3)

'(eof)
Tourist Trap
Posts: 2768
Joined: Jun 02, 2015 16:24

Re: Need help with implementation of variant-array

Postby Tourist Trap » Aug 31, 2016 9:05

fxm wrote:Does not work (obviously the string fields are destroyed before use):

True. But in fact I don't want pointers at all. This was at the very first attemps the only way for me to get the things work so I've done things like this. But ultimately the variant should be values as they are in the MOD example.

Unless it's impossible for some reason with the ABSTRACT stuff. I don't know. In this case using NEW would be ok. Maybe I've not tested enough, and missed only a little point about making this all values.

NEW doesn't work in the implementation with ABSTRACT:

Code: Select all

'*root*         -> TYPECAP                                         
'integer        -> INTEGERCAP                                     
'single         -> SINGLECAP                                       
'zstring_ptr    -> ZSTRINGPTRCAP                                   


type TYPECAP extends OBJECT
    declare abstract operator cast() as integer
    declare abstract operator cast() as single
    declare abstract operator cast() as string
    declare abstract property MinValue() as integer
    declare abstract property MaxValue() as integer
    declare abstract property ClosestToZeroValue() as single
    declare abstract property ClosestToInfValue() as single
    declare abstract function GetType() as string
    declare abstract function ToString() as string
end type
type VARIANT as TYPECAP ptr


type INTEGERCAP extends TYPECAP
    declare constructor()
    declare constructor(byval I as integer)
    declare virtual property MinValue() as integer override
    declare virtual property MaxValue() as integer override
    declare operator let(byref as integer)
    declare virtual operator cast() as integer override
    declare virtual operator cast() as single override
    declare virtual operator cast() as string override
    declare virtual function GetType() as string override
    declare virtual function ToString() as string override
        as integer  _value
end type
constructor INTEGERCAP()
    BASE()
end constructor
constructor INTEGERCAP(byval I as integer)
   BASE()
   THIS._value => I
end constructor
property INTEGERCAP.MinValue() as integer
   #if __FB_64BIT__
       dim as integer min => &H8000000000000000
   #else
       dim as integer min => &H80000000
   #endif
   '---->
   return min
end property
property INTEGERCAP.MaxValue() as integer
   #if __FB_64BIT__
       dim as integer max => &H7FFFFFFFFFFFFFFF
   #else
       dim as integer max => &H7FFFFFFF
   #endif
   '---->
   return max
end property
operator INTEGERCAP.let(byref LetValue as integer)
    THIS._value = LetValue
end operator
operator INTEGERCAP.cast() as integer
    '---->
    return THIS._value
end operator
operator INTEGERCAP.cast() as single
    '---->
    return THIS._value
end operator
operator INTEGERCAP.cast() as string
    '---->
    return Str(THIS._value)
end operator
function INTEGERCAP.GetType() as string
    '---->
    return "integercap"
end function
function INTEGERCAP.ToString() as string
   '---->
   return str(THIS._value)
end function

type SINGLECAP extends TYPECAP
    declare constructor()
    declare constructor(byval S as single)
    declare virtual property ClosestToZeroValue() as single override
    declare virtual property ClosestToInfValue() as single override
    declare operator let(byref as single)
    declare virtual operator cast() as integer override
    declare virtual operator cast() as single override
    declare virtual operator cast() as string override
    declare virtual function GetType() as string override
    declare virtual function ToString() as string override
        as single  _value
end type
constructor SINGLECAP()
    BASE()
end constructor
constructor SINGLECAP(byval S as single)
   BASE()
   THIS._value => S
end constructor
property SINGLECAP.ClosestToZeroValue() as single
   '---->
   return 1.401298e-45
end property
property SINGLECAP.ClosestToInfValue() as single
   '---->
   return 3.402823e+38
end property
operator SINGLECAP.let(byref LetValue as single)
    THIS._value = LetValue
end operator
operator SINGLECAP.cast() as integer
    '---->
    return THIS._value
end operator
operator SINGLECAP.cast() as single
    '---->
    return THIS._value
end operator
operator SINGLECAP.cast() as string
    '---->
    return Str(THIS._value)
end operator
function SINGLECAP.GetType() as string
    '---->
    return "singlecap"
end function
function SINGLECAP.ToString() as string
   '---->
   return str(THIS._value)
end function

type ZSTRINGPTRCAP extends TYPECAP
    declare constructor()
    declare constructor(byval Z as zstring ptr)
    declare operator let(byref as zstring ptr)
    declare virtual operator cast() as integer override
    declare virtual operator cast() as single override
    declare virtual operator cast() as string override
    declare virtual function GetType() as string override
    declare virtual function ToString() as string override
        as zstring ptr  _value
end type
constructor ZSTRINGPTRCAP()
    BASE()
end constructor
constructor ZSTRINGPTRCAP(byval Z as zstring ptr)
    BASE()
    THIS._value => Z
end constructor
operator ZSTRINGPTRCAP.let(byref LetValue as zstring ptr)
    THIS._value = LetValue
end operator
operator ZSTRINGPTRCAP.cast() as integer
    '---->
    return Val(*THIS._value)
end operator
operator ZSTRINGPTRCAP.cast() as single
    '---->
    return Val(*THIS._value)
end operator
operator ZSTRINGPTRCAP.cast() as string
    '---->
    return *THIS._value
end operator
function ZSTRINGPTRCAP.GetType() as string
    '---->
    return "zstringptrcap"
end function
function ZSTRINGPTRCAP.ToString() as string
   '---->
   return *THIS._value
end function

'````````````````````````````````````````````````````````````````````
'define an array of variant
dim as VARIANT   arrayOfVariant(any)

'fill the array
redim arrayOfVariant(1 to 3)
arrayOfVariant(1) = new INTEGERCAP(99)                  ''Not ok...
arrayOfVariant(2) = new SINGLECAP(3.1415)
arrayOfVariant(3) = new ZSTRINGPTRCAP("hello_variant")

'now you can get back the type of each variable stored as well as its value
? 1, arrayOfVariant(1)->GetType(), *arrayOfVariant(1)
? 2, arrayOfVariant(2)->GetType(), *arrayOfVariant(2)
? 3, arrayOfVariant(3)->GetType(), *arrayOfVariant(3)
?

'some operations
? "? 1+2+3", *arrayOfVariant(1) + *arrayOfVariant(2) + *arrayOfVariant(3)
? "? 1&2&3", *arrayOfVariant(1) & *arrayOfVariant(2) & *arrayOfVariant(3)
?

'other operations
? *arrayOfVariant(1) + *arrayOfVariant(2)
? *arrayOfVariant(1) & *arrayOfVariant(2)
? *arrayOfVariant(3)
?


'ToString method
? (type<SINGLECAP>(*arrayOfVariant(2) + *arrayOfVariant(1))).ToString() ''error 305: UDT has unimplemented abstract methods
? (SINGLECAP(*arrayOfVariant(2) + *arrayOfVariant(1))).ToString()      ''OK


? arrayOfVariant(2)->ToString()
? arrayOfVariant(3)->ToString()

? arrayOfVariant(2)->ClosestToZeroValue

'````````````````````````````````````````````````````````````````````
getKey()

'(eof)


Reading again my usage of temporary type, it's not about the initialization of the array (if done there, this was just as a placeholder), it's here:

Code: Select all

type<SINGLECAP>(*arrayOfVariant(2) + *arrayOfVariant(1))).ToString()

This is something perfecltly legit then, the type is made the time to call ToString and then vanishes. But it's broken, and I think this is not what should happen. By the way fortunately it's ok if constructor without temporary syntax is called.
When I've talked of BUG it was about this, not about the array initialization, sorry if I'vn't been clear.
fxm
Posts: 9315
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Need help with implementation of variant-array

Postby fxm » Aug 31, 2016 9:38

fxm wrote:@dkl,

The syntax "UDT()" accepts to create a temporary object of a Type that does not implement an abstract method!

(The syntax "Type<UDT>()" refuses this as normally expected)

About that, I am waiting the dkl's response but I think that none object (static, dynamic and temporary) should be authorized to be created from a Type that does not implement all abstract methods.

Return to “General”

Who is online

Users browsing this forum: No registered users and 1 guest