This is a follow-up on Bug #4738. I did more testing and have a clearer idea of why it throws an EVariantError exception.

GetPropValue doesn't handle enumerated types correctly when GetPropValue gets called with the 3rd parameter (PreferStrings) set to True (the default).

GetPropValue returns a corrupt Variant of some sorts. Trying to assign that variant to an enumerated type property using or a direct assignment or via the SetPropValue raises the EVariantError exception.

I included the output showing the error and the desired result. Also included is a much simpler example showing the bug compared to the example referred to in the bug report 4738.

Hope this will help in solving the problem.

Compiler used: 2.0.2 release
OS Tested: Linux, Win2000

Regards,
- Graeme -

---------- PrefferString := True ------------------------------------------ ./enum
String:abcde ; Int:12345 ; Enum:Male ;
String: ; Int:0 ; Enum:Unknown ;
An unhandled exception occurred at $08099475 :
EVarianterror :
$08099475
$0809AB7C
$0808A426
$0805390B
$08091210
$080482DD TTESTOBJ__ASSIGNRTTI2, line 61 of enum.lpr ---------- PrefferString := True ------------------------------------------

---------- PrefferString := False  ------------------------------------------
 ./enum
String:abcde ; Int:12345 ; Enum:Male ;
String: ; Int:0 ; Enum:Unknown ;
String:abcde ; Int:12345 ; Enum:Male ;
---------- PrefferString := True  ------------------------------------------
----------------- enum.lpr  --------------------------
program enum;
{$mode objfpc}{$H+}
uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, SysUtils, TypInfo, Variants;
type
  TGender = (genUnknown, genMale, genFemale);
const
  cGenderGUI : array[TGender] of string =
    ( 'Unknown', 'Male', 'Female' );
type
  TTestObj = class(TPersistent)
  private
    FPropStr: String;
    FPropInt: integer;
    FPropOrd: TGender;
  public
    procedure   AssignRTTI1(Source: TPersistent);
    procedure   AssignRTTI2(Source: TPersistent);
    procedure   Assign(Source: TPersistent); override;
    function    ToString: string;
  published
    property    PropStr: String read FPropStr write FPropStr;
    property    PropInt: integer read FPropInt write FPropInt;
    property    PropOrd: TGender read FPropOrd write FPropOrd;
  end;

{ TTestObj }

procedure TTestObj.AssignRTTI1(Source: TPersistent);
begin
  SetPropValue(Self, 'PropStr', TTestObj(Source).PropStr);
  SetPropValue(Self, 'PropInt', TTestObj(Source).PropInt);
  SetPropValue(Self, 'PropOrd', TTestObj(Source).PropOrd);
end;
procedure TTestObj.AssignRTTI2(Source: TPersistent);
var
  lPropValue: Variant;
begin
  lPropValue := GetPropValue(Source, 'PropStr');        { passed }
  SetPropValue(Self, 'PropStr', lPropValue);
  lPropValue := GetPropValue(Source, 'PropInt');        { passed }
  SetPropValue(Self, 'PropInt', lPropValue);
//  lPropValue := GetPropValue(Source, 'PropOrd', False); { passed }
  lPropValue := GetPropValue(Source, 'PropOrd'); { fails }
  SetPropValue(Self, 'PropOrd', lPropValue);
//  PropOrd := lPropValue;                              { also fails }
end;
procedure TTestObj.Assign(Source: TPersistent);
begin
  PropStr := TTestObj(Source).PropStr;
  PropInt := TTestObj(Source).PropInt;
  PropOrd := TTestObj(Source).PropOrd;
end;
function TTestObj.ToString: string;
const
  C = 'String:%s ; Int:%d ; Enum:%s ;';
begin
  Result := Format(C, [PropStr, PropInt, cGenderGUI[PropOrd]]);
end;
var
  A, B: TTestObj;
begin
  A := TTestObj.Create;
  B := TTestObj.Create;
  try
    A.PropStr := 'abcde';
    A.PropInt := 12345;
    A.PropOrd := genMale;
    Writeln(A.ToString);
    { output empty properties }
    Writeln(B.ToString);
//    B.Assign(A);          { works }
//    B.AssignRTTI1(A);     { works }
    B.AssignRTTI2(A);       { fails }
    Writeln(B.ToString);
  finally
    B.Free;
    A.Free;
  end;
end.

--------------------- end -------------------------------

While I think this is a bug that should be solved, I would suggest to avoid the use of variants as much as possible. Your code can be made a lot faster (and bug-free) by avoiding the use of variants in the first place. This is valid for FPC, but also for Delphi.

Michael.

Hi Michael,

I do understand that variants are slow, but unfortunately I can't get rid of them. I use the tiOPF framework and in the framework we created a generic Assign method in our base class used for all objects.

The Assign uses RTTI extensively with variants to handle all datatypes, except class types that the user might have added. This works perfectly, and the user never needs to worry about creating a custom Assign method for any object, the framework handles all that.

The original example referred to in the bug report shows a bit of how the framework does that, but might have complicated the example app to much. That is why I posted a much simpler example now.

Regards,
- Graeme -

I thought it came from there.

Even so:
This Assign() method does not need to use a variant, but can still offer the same functionality as it does now. It just means that the method needs to determine the actual type itself...

Variants are not required for this.
Variants are for (excuse me the term) lazy coders...

But I don't suggest rewriting tiOPF for this, it might lead a little bit too far :-)

Michael.

Variants are not required for this. Variants are for (excuse me the term) lazy coders...

I assure you that implementing variants is not for lazy coders. ;)

Joost.

ps: not that you don't know that

Even so: This Assign() method does not need to use a variant, but can still offer the same functionality as it does now. It just means that the method needs to determine the actual type itself...

tiOPF has done a lot to get rid of using variants and it isn't used that much anymore. If there is anything else we can do to get rid of the last few cases, we would.
Below is one of the methods used in the Assign method. GetPropValue and SetPropValue returns/uses Variant, so how would you do it otherwise using RTTI?
eg: Query PropInfo and call the individual methods (GetOrdProp, GetStrProp, etc.) based on PropInfo.Kind in a case statement?

const
  // All string type properties
  ctkString = [ tkChar, tkString, tkWChar, tkLString, tkWString
                        {$IFDEF FPC},tkAString{$ENDIF} ] ;
  // Integer type properties
  ctkInt    = [ tkInteger, tkInt64 ] ;
  // Float type properties
  ctkFloat  = [ tkFloat ] ;
  // Numeric type properties
  ctkNumeric = [tkInteger, tkInt64, tkFloat];
  // All simple types (string, int, float)
  ctkSimple = ctkString + ctkInt + ctkFloat ;
procedure TtiObject.AssignPublishedProp( pSource : TtiObject ;
psPropName : string) ;
var
  lPropType: TTypeKind;
  lPropValue: Variant;
begin
  lPropType := TypInfo.PropType( pSource, psPropName ) ;
  if lPropType in ctkSimple + [tkVariant, tkEnumeration] then
  begin
    { Graeme 2006-05-16: Passing in False, as a workaround for a FPC bug. }
    lPropValue := TypInfo.GetPropValue(pSource, psPropName, False);
    TypInfo.SetPropValue( Self, psPropName, lPropValue);
  end
  else
    raise EtiOPFProgrammerException.CreateFmt(cErrorSettingProperty,
      [ClassName, psPropName, 'Unknown property type']);
end ;

Variants are for (excuse me the term) lazy coders...

I've heard that before.. :-)

Graeme.

Is there any way to add extra notes to the original bug report, otherwise whoever looks at that bug report will never know about this post and the easier example?

Graeme.

Graeme Geldenhuys wrote

This is a follow-up on Bug #4738. I did more testing and have a clearer idea of why it throws an EVariantError exception.

Change your code to something like

        Case lproptype of
          tkInteger : SetIntProp(Self,psPropName,GetIntProp(psource,pspropname));
          tkString  : SetStrProp(Self,psPropName,GetStrProp(psource,pspropname));
          // And so on. See e.g. RTTIUtils for a more complete list.
       else
         Raise Exception.Create(UnSupportedRTTIType)
       end;
                      ;

> > Variants are for (excuse me the term) lazy coders... > > I've heard that before.. :-)

It must be true then :-)

Michael.

Thanks Michael. I'll have a look at RTTIUtils now,

Graeme.