View Issue Details

IDProjectCategoryView StatusLast Update
0038357pas2jsrtlpublic2021-01-14 23:17
Reporterhenrique Assigned ToMattias Gaertner  
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionfixed 
PlatformPas2JsOSWindows 
Summary0038357: Implementation of SetArrayElement
DescriptionI 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.
TagsNo tags attached.
Fixed in Revision
Attached Files

Activities

henrique

2021-01-14 18:39

reporter  

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

Mattias Gaertner

2021-01-14 23:12

manager   ~0128330

TTypeInfoDynArray.DimCount was obsolete. A dynamic array has always the dimension 1.

Mattias Gaertner

2021-01-14 23:17

manager   ~0128332

Fixed TTypeInfoStaticArray.Dims

Issue History

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