[fpc-devel] GetPropValue and enumerated types (Bug #4738 follow-up)
Michael Van Canneyt
michael at freepascal.org
Wed May 17 10:24:21 CEST 2006
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 ------------------------------------------
> graemeg at porky:~/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 ------------------------------------------
> graemeg at porky:~/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
>
More information about the fpc-devel
mailing list