[fpc-pascal] RTTI Bug or something else i did wrong...

[Jorge Aldo G. de F. Junior]

The following code:
---------------------------------------------------------
Unit
	RTTIObject;

Interface

Uses
	Classes,
	SysUtils,
	StrUtils,
	Contnrs,
	TypInfo;

Type
 TRTTIObject = Class(TObject)
	Private
		fInstanceName: String;
  fTypeData: PTypeData;
  fPropList: PPropList;
  fNumProperties: Integer;
	Protected
		Procedure SetProperty(Const aName, aValue: String); Overload;
		Function GetProperty(Const aName: String): String; Overload;
		Procedure SetProperty(Const aIndex: Integer; aValue: String); Overload;
		Function GetProperty(Const aIndex: Integer): String; Overload;
		Function GetPropertyName(Const aIndex: Integer): String;
		Function GetPropertyType(Const aIndex: Integer): String;
		Function GetPropertyIndex(Const aName: String): Integer;
	Public
		Constructor Create(Const aInstanceName: String); Virtual;
		Destructor Destroy; Override;
		Property Properties[aName: String]: String Read GetProperty Write SetProperty;
		Property Properties[aIndex: Integer]: String Read GetProperty Write
SetProperty;
		Property PropertyCount: Integer Read fNumProperties;
	Published
		Property InstanceName: String Read fInstanceName;
	End;
	
Implementation

Procedure TRTTIObject.SetProperty(Const aName, aValue: String);
Var
  lRow : Integer;
Begin
	lRow := GetPropertyIndex(aName);
	SetProperty(lRow, aValue);
End;

Function TRTTIObject.GetProperty(Const aName: String): String;
Var
  lRow : Integer;
 Begin
	lRow := GetPropertyIndex(aName);
	Result := GetProperty(lRow);
End;

Procedure TRTTIObject.SetProperty(Const aIndex: Integer; aValue: String);
Var
	lName: String;
Begin
 lName := fPropList^[aIndex]^.Name;
	Case fPropList^[aIndex]^.PropType^.Kind Of
		tkInteger : SetOrdProp(Self, lName, StrToInt(aValue));
		tkFloat   : If fPropList^[aIndex]^.PropType^.Name = 'TDateTime' Then
															SetFloatProp(Self, lName, StrToDateTime(aValue))
														Else
															SetFloatProp(Self, lName, StrToFloat(aValue));
		tkSString : SetStrProp(Self, lName, aValue);
		tkLString : SetStrProp(Self, lName, aValue);
		tkAString : SetStrProp(Self, lName, aValue);
		tkWString : SetStrProp(Self, lName, aValue);
		tkVariant : SetVariantProp(Self, lName, aValue);
		tkBool    : SetOrdProp(Self, lName, Ord(LowerCase(aValue) = 'true'));
		tkInt64   : SetOrdProp(Self, lName, StrToInt(aValue));
		tkQWord   : SetOrdProp(Self, lName, StrToInt(aValue));
		tkUString : SetStrProp(Self, lName, aValue);
	End;
End;

Function TRTTIObject.GetProperty(Const aIndex: Integer): String;
Var
	lName: String;
Begin
	lName := fPropList^[aIndex]^.Name;
	Case fPropList^[aIndex]^.PropType^.Kind Of
		tkInteger : Result := IntToStr(GetOrdProp(Self, lName));
		tkFloat   : If fPropList^[aIndex]^.PropType^.Name = 'TDateTime' Then
															Result := DateTimeToStr(GetFloatProp(Self, lName))
														Else
															Result := FloatToStr(GetFloatProp(Self, lName));
		tkSString : Result := GetStrProp(Self, lName);
		tkLString : Result := GetStrProp(Self, lName);
		tkAString : Result := GetStrProp(Self, lName);
		tkWString : Result := GetStrProp(Self, lName);
		tkVariant : Result := GetVariantProp(Self, lName);
		tkBool    : If Boolean(GetOrdProp(Self, lName)) Then
															Result := 'True'
														Else
															Result := 'False';
		tkInt64   : Result := IntToStr(GetOrdProp(Self, lName));
		tkQWord   : Result := IntToStr(GetOrdProp(Self, lName));
		tkUString : Result := GetStrProp(Self, lName);
	End;
End;

Function TRTTIObject.GetPropertyName(Const aIndex: Integer): String;
Begin
	Result := fPropList^[aIndex]^.Name;
End;

Function TRTTIObject.GetPropertyType(Const aIndex: Integer): String;
Begin
	Result := fPropList^[aIndex]^.PropType^.Name;
End;

Function TRTTIObject.GetPropertyIndex(Const aName: String): Integer;
Var
  lRow : Integer;
  lName : String;
Begin
	Result := -1;
	For lRow := 0 To fNumProperties - 1 Do
			Begin
					lName := GetPropertyName(lRow);
					If lName = aName Then
							Begin
									Result := lRow;
									Break;
							End;
			End;
End;

Constructor TRTTIObject.Create(Const aInstanceName: String);
Begin
 Inherited Create;
 fInstanceName := aInstanceName;
 fTypeData := GetTypeData(Self.ClassInfo);
 GetMem(fPropList, fTypeData^.PropCount * SizeOf(Pointer));
 fNumProperties := GetPropList(Self.ClassInfo, [ tkInteger, tkFloat,
tkSString, tkLString, tkAString, tkWString, tkVariant, tkBool,
tkInt64, tkQWord, tkUString ], fPropList);
End;

Destructor TRTTIObject.Destroy;
Begin
 FreeMem(fPropList, fTypeData^.PropCount * SizeOf(Pointer));
	Inherited Destroy;
End;

End.
---------------------------------
Uses
	RTTIObject;

Var
	MyRTTIObject : TRTTIObject;

Begin
	MyRTTIObject := TRTTIObject.Create('MyRTTIObject');
	MyRTTIObject.Free;
End.
--------------------------------------


gives strange results...

the compiler issues no warning whatsoever but when i try to run the
compiled test program, it gives this :

---------------------------------
C:\Programacao\testcase>rttiobject-testcase.exe
An unhandled exception occurred at $0040E1E7 :
EAccessViolation : Access violation
  $0040E1E7  TRTTIOBJECT__DESTROY,  line 143 of RTTIObject.pas
  $0040E18A  TRTTIOBJECT__CREATE,  line 139 of RTTIObject.pas
  $00401515  main,  line 8 of rttiobject-testcase.pas
---------------------------------------------------------

looks like the constructor is calling the destructor before doing
anything at all...

what i did wrong ?