On Wed, 17 May 2006, 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.

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.

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.


Compiler used:  2.0.2 release
OS Tested:  Linux, Win2000

Regards,
 - Graeme -




---------- PrefferString := True  ------------------------------------------
[EMAIL PROTECTED]:~/programming/tests/enum_type$ ./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  ------------------------------------------
[EMAIL PROTECTED]:~/programming/tests/enum_type$ ./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 -------------------------------



--
There's no place like 127.0.0.1

_______________________________________________
fpc-devel maillist  -  fpc-devel@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-devel

Reply via email to