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