View Issue Details
ID | Project | Category | View Status | Date Submitted | Last Update |
---|---|---|---|---|---|
0038357 | pas2js | rtl | public | 2021-01-14 18:39 | 2021-01-14 23:17 |
Reporter | henrique | Assigned To | Mattias Gaertner | ||
Priority | normal | Severity | minor | Reproducibility | always |
Status | resolved | Resolution | fixed | ||
Platform | Pas2Js | OS | Windows | ||
Summary | 0038357: Implementation of SetArrayElement | ||||
Description | I implemented the "SetArrayElement" procedure that I didn't have in RTTI. But I encountered a problem, in the TValue GetArrayElement function, that checks for a property called DimCount of the TTypeInfoDynArray and Dims of the TTypeInfoStaticArray. I found no references from them in RTL.js, and with that do not know are generated in the compilation or elsewhere. With this I moved the source to the IsArray function and left commented the source where I believe that the check should be done if these fields existed effectively. | ||||
Tags | No tags attached. | ||||
Fixed in Revision | |||||
Attached Files |
|
|
0001-Implementa-o-do-SetArrayElement-que-n-o-tinha.patch (6,673 bytes)
From b1e75e045b4fe7197257dbc1117db3982a1f60d6 Mon Sep 17 00:00:00 2001 From: Henrique Gottardi Werlang <henriquewerlang@hotmail.com> Date: Thu, 14 Jan 2021 14:29:49 -0300 Subject: [PATCH] =?UTF-8?q?Implementa=C3=A7=C3=A3o=20do=20SetArrayElement?= =?UTF-8?q?=20que=20n=C3=A3o=20tinha.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- packages/rtl/rtti.pas | 113 +++++++++++++++++++++++++++--------------- 1 file changed, 73 insertions(+), 40 deletions(-) diff --git a/packages/rtl/rtti.pas b/packages/rtl/rtti.pas index 6dbf186..393527b 100644 --- a/packages/rtl/rtti.pas +++ b/packages/rtl/rtti.pas @@ -60,10 +60,13 @@ type function ToString: String; function GetArrayLength: SizeInt; function GetArrayElement(aIndex: SizeInt): TValue; - //ToDo: procedure SetArrayElement(aIndex: SizeInt; constref AValue: TValue); + procedure SetArrayElement(aIndex: SizeInt; const AValue: TValue); + procedure SetArrayLength(const Size: SizeInt); function IsType(ATypeInfo: PTypeInfo): boolean; function AsJSValue: JSValue; class function Empty: TValue; static; + class function Make(TypeInfo: TTypeInfo; const Value: JSValue): TValue; static; + class function Make(const Value: TValue): TValue; static; end; TRttiType = class; @@ -179,7 +182,6 @@ type constructor Create(AParent: TRttiType; ATypeInfo: TTypeMember); function GetValue(Instance: TObject): TValue; - procedure SetValue(Instance: TObject; const AValue: JSValue); overload; procedure SetValue(Instance: TObject; const AValue: TValue); overload; @@ -519,44 +521,58 @@ end; generic class function TValue.From<T>(const Value: T): TValue; begin - Result := FromJSValue(Value); + Result := Make(System.TypeInfo(T), Value); +end; + +class function TValue.Make(TypeInfo: TTypeInfo; const Value: JSValue): TValue; +begin + Result.FData := Value; + Result.FTypeInfo := TypeInfo; +end; + +class function TValue.Make(const Value: TValue): TValue; +begin + Result := TValue.Make(Value.TypeInfo, Value.AsJSValue); end; class function TValue.FromJSValue(v: JSValue): TValue; var i: NativeInt; + TypeOfValue: TTypeInfo; + begin - Result.FData:=v; case jsTypeOf(v) of 'number': if JS.isInteger(v) then begin i:=NativeInt(v); if (i>=low(integer)) and (i<=high(integer)) then - Result.FTypeInfo:=system.TypeInfo(Integer) + TypeOfValue:=system.TypeInfo(Integer) else - Result.FTypeInfo:=system.TypeInfo(NativeInt); + TypeOfValue:=system.TypeInfo(NativeInt); end else Result.FTypeInfo:=system.TypeInfo(Double); - 'string': Result.FTypeInfo:=system.TypeInfo(String); - 'boolean': Result.FTypeInfo:=system.TypeInfo(Boolean); + 'string': TypeOfValue:=system.TypeInfo(String); + 'boolean': TypeOfValue:=system.TypeInfo(Boolean); 'object': begin if v=nil then - Result.FTypeInfo:=system.TypeInfo(Pointer) + TypeOfValue:=system.TypeInfo(Pointer) else if JS.isClass(v) and JS.isExt(v,TObject) then - Result.FTypeInfo:=system.TypeInfo(TClass(v)) + TypeOfValue:=system.TypeInfo(TClass(v)) else if JS.isObject(v) and JS.isExt(v,TObject) then - Result.FTypeInfo:=system.TypeInfo(TObject(v)) + TypeOfValue:=system.TypeInfo(TObject(v)) else - Result.FTypeInfo:=system.TypeInfo(Pointer); - if (Result.FTypeInfo=JS.Undefined) or (Result.FTypeInfo=nil) then - Result.FTypeInfo:=system.TypeInfo(Pointer); + TypeOfValue:=system.TypeInfo(Pointer); + if (TypeOfValue=JS.Undefined) or (TypeOfValue=nil) then + TypeOfValue:=system.TypeInfo(Pointer); end else - Result.FTypeInfo:=system.TypeInfo(JSValue); + TypeOfValue:=system.TypeInfo(JSValue); end; + + Result := Make(TypeOfValue, v); end; function TValue.IsObject: boolean; @@ -580,6 +596,11 @@ end; function TValue.IsArray: boolean; begin Result := Kind in [tkArray, tkDynArray]; +// case Kind of +// tkDynArray: Exit(TTypeInfoDynArray(FTypeInfo).DimCount = 1); +// tkArray: Exit(Length(TTypeInfoStaticArray(FTypeInfo).Dims) = 1); +// else Result := False; +// end; end; function TValue.IsClass: boolean; @@ -687,35 +708,48 @@ end; function TValue.GetArrayLength: SizeInt; begin - if not IsArray then - raise EInvalidCast.Create(SErrInvalidTypecast); - Result:=length(TJSValueDynArray(FData)); + if IsArray then + Exit(Length(TJSValueDynArray(FData))); + + raise EInvalidCast.Create(SErrInvalidTypecast); end; function TValue.GetArrayElement(aIndex: SizeInt): TValue; -var - StaticTI: TTypeInfoStaticArray; - DynIT: TTypeInfoDynArray; begin - case Kind of - tkDynArray: - begin - DynIT:=TTypeInfoDynArray(FTypeInfo); - Result.FTypeInfo:=DynIT.ElType; - if DynIT.DimCount<>1 then - raise EInvalidCast.Create(SErrInvalidTypecast); - end; - tkArray: - begin - StaticTI:=TTypeInfoStaticArray(FTypeInfo); - if length(StaticTI.Dims)<>1 then - raise EInvalidCast.Create(SErrInvalidTypecast); - Result.FTypeInfo:=StaticTI.ElType; + if IsArray then + begin + case Kind of + tkArray: Result.FTypeInfo:=TTypeInfoStaticArray(FTypeInfo).ElType; + tkDynArray: Result.FTypeInfo:=TTypeInfoDynArray(FTypeInfo).ElType; end; + + Result.FData:=TJSValueDynArray(FData)[aIndex]; + end + else + raise EInvalidCast.Create(SErrInvalidTypecast); +end; + +procedure TValue.SetArrayLength(const Size: SizeInt); +var + NewArray: TJSValueDynArray; + +begin + NewArray := TJSValueDynArray(FData); + + SetLength(NewArray, Size); + + FData := NewArray; +end; + +procedure TValue.SetArrayElement(aIndex: SizeInt; const AValue: TValue); +var + ValueTypeInfo: TTypeInfo; + +begin + if IsArray then + TJSValueDynArray(FData)[aIndex] := AValue.AsJSValue else raise EInvalidCast.Create(SErrInvalidTypecast); - end; - Result.FData:=TJSValueDynArray(FData)[aIndex]; end; function TValue.IsType(ATypeInfo: PTypeInfo): boolean; @@ -1173,15 +1207,14 @@ end; function TRttiProperty.GetValue(Instance: TObject): TValue; begin - Result := TValue.FromJSValue(GetJSValueProp(Instance, PropertyTypeInfo)); + Result := TValue.Make(PropertyType.Handle, GetJSValueProp(Instance, PropertyTypeInfo)); end; procedure TRttiProperty.SetValue(Instance: TObject; const AValue: TValue); begin - SetJSValueProp(Instance, PropertyTypeInfo, AValue); + SetJSValueProp(Instance, PropertyTypeInfo, AValue.AsJSValue); end; - procedure TRttiProperty.SetValue(Instance: TObject; const AValue: JSValue); begin SetJSValueProp(Instance, PropertyTypeInfo, AValue); -- 2.30.0.windows.1 |
|
TTypeInfoDynArray.DimCount was obsolete. A dynamic array has always the dimension 1. |
|
Fixed TTypeInfoStaticArray.Dims |
Date Modified | Username | Field | Change |
---|---|---|---|
2021-01-14 18:39 | henrique | New Issue | |
2021-01-14 18:39 | henrique | File Added: 0001-Implementa-o-do-SetArrayElement-que-n-o-tinha.patch | |
2021-01-14 22:57 | Mattias Gaertner | Assigned To | => Mattias Gaertner |
2021-01-14 22:57 | Mattias Gaertner | Status | new => assigned |
2021-01-14 23:12 | Mattias Gaertner | Note Added: 0128330 | |
2021-01-14 23:17 | Mattias Gaertner | Status | assigned => resolved |
2021-01-14 23:17 | Mattias Gaertner | Resolution | open => fixed |
2021-01-14 23:17 | Mattias Gaertner | Note Added: 0128332 |