rtti: TRttiStringType

packages/rtl/src/generics.collections.pas

@@ -1911,7 +1911,7 @@ end;
 procedure TQueue<T>.Rebase;
 
 Var
-  I,Spare : integer;
+  I : integer;
 
 begin
   if FLow>0 then

packages/rtl/src/rtti.pas

@@ -494,6 +494,11 @@ type
     property ExternalName: String read GetExternalName;
   end;
 
+  { TRttiFloatType }
+
+  TRttiFloatType = class(TRttiType)
+  end;
+
   { TRttiOrdinalType }
 
   TRttiOrdinalType = class(TRttiType)
@@ -783,10 +788,10 @@ var
     nil, // tkUnknown
     TRttiOrdinalType, // tkInteger
     TRttiOrdinalType, // tkChar
-    TRttiType, // tkString
+    TRttiStringType, // tkString
     TRttiEnumerationType, // tkEnumeration
     TRttiType, // tkSet
-    TRttiType, // tkDouble
+    TRttiFloatType, // tkDouble
     TRttiType, // tkBool
     TRttiProcedureType, // tkProcVar
     TRttiMethodType, // tkMethod
@@ -1359,25 +1364,63 @@ begin
 end;
 
 function TValue.ToString(const AFormatSettings: TFormatSettings): String;
+var
+  v: JSValue;
+  Cls: TClass;
 begin
   if IsEmpty then
     Exit('(empty)');
 
   case Kind of
+    tkInteger: Result := IntToStr(AsNativeInt);
+    tkChar,
+    tkString: Result := AsString;
+    tkEnumeration: Result := GetEnumName(TTypeInfoEnum(TypeInfo), AsOrdinal);
+    tkSet: Result := SetToString(TypeInfo, AsJSValue, True);
+    tkDouble: Result := FloatToStr(AsExtended, AFormatSettings);
     tkBool: Result := BoolToStr(AsBoolean, True);
+    tkProcVar: Result:='(function '+TypeInfo.Name+')';
+    tkMethod: Result:='(method '+str(TTypeInfoMethodVar(TypeInfo).MethodKind)+' '+TypeInfo.Name+')';
+    tkArray:
+      begin
+      // todo: multi Dims
+      Result:='(array[0..'+str(GetArrayLength)+'] of '+TTypeInfoStaticArray(TypeInfo).ElType.Name+')';
+      end;
+    tkDynArray:
+      Result:='(dynamic array[0..'+str(GetArrayLength)+'] of '+TTypeInfoDynArray(TypeInfo).ElType.Name+')';
+    tkRecord: Result := '(' + TypeInfo.Name + ' record)';
     tkClass:
-    begin
       if Assigned(AsObject) then
         Result := AsObject.ClassName
       else
         Result := '(empty)';
-    end;
+    tkClassRef:
-    tkClassRef: Result := AsClass.ClassName;
+      begin
-    tkEnumeration: Result := GetEnumName(TTypeInfoEnum(TypeInfo), AsOrdinal);
+      Cls:=AsClass;
-    tkFloat: Result := FloatToStr(AsExtended, AFormatSettings);
+      if Assigned(Cls) then
-    tkInteger: Result := IntToStr(AsNativeInt);
+        Result := '(class '''+Cls.ClassName+''')'
-    tkChar,
+      else
-    tkString: Result := AsString;
+        Result:='<empty class ref>';
+      end;
+    tkPointer:
+      if AsJSValue=nil then
+        Result:='(pointer nil)'
+      else
+        Result := '(pointer)';
+    tkJSValue:
+      begin
+      v:=AsJSValue;
+      if v=nil then
+        Result := '(jsvalue nil)'
+      else if isNumber(v) or isString(v) or isUndefined(v) or isBoolean(v) then
+        Result := '(jsvalue '+String(v)+')'
+      else
+        Result := '(jsvalue)';
+      end;
+    tkRefToProcVar: Result := '(variable of procedure type '+TypeInfo.Name+')';
+    tkInterface: Result := '(interface '+TypeInfo.Name+')';
+    tkHelper: Result := '(helper '+TypeInfo.Name+')';
+    tkExtClass: Result := '(external class '+TypeInfo.Name+')';
   else
     Result := '';
   end;
@@ -1957,7 +2000,6 @@ begin
 end;
 
 function TRttiArrayType.GetDimension(aIndex: SizeInt): TRttiType;
-
 begin
   if (aIndex >= DimensionCount) then
     raise ERtti.CreateFmt(SErrDimensionOutOfRange, [aIndex, DimensionCount]);
@@ -1965,7 +2007,6 @@ begin
     Result:=TRttiArrayType(ElementType).Dimensions[aIndex-1]
   else
     Result :=ElementType;
-//  Result:=StaticArrayTypeInfo.Dims[aIndex];
 end;
 
 function TRttiArrayType.GetElementType: TRttiType;

packages/rtl/src/typinfo.pas

@@ -507,6 +507,10 @@ function GetRawInterfaceProp(Instance: TObject; PropInfo: TTypeMemberProperty):
 procedure SetRawInterfaceProp(Instance: TObject; const PropName: string; const Value: Pointer);
 procedure SetRawInterfaceProp(Instance: TObject; PropInfo: TTypeMemberProperty; const Value: Pointer);
 
+function SetToString(TypeInfo: TTypeInfo; Value: JSValue; Brackets: Boolean) : String;
+function SetToString(PropInfo: TTypeMemberProperty; Value: JSValue; Brackets: Boolean) : String;
+function SetToString(PropInfo: TTypeMemberProperty; Value: JSValue) : String;
+
 implementation
 
 function GetTypeName(TypeInfo: TTypeInfo): string;
@@ -1282,31 +1286,9 @@ function GetSetProp(Instance: TObject; const PropInfo: TTypeMemberProperty
   ): String;
 var
   o: TJSObject;
-  key, Value: String;
-  n: NativeInt;
-  TIEnum: TTypeInfoEnum;
-  TISet: TTypeInfoSet;
 begin
-  Result:='';
-  // get enum type if available
-  TISet:=PropInfo.TypeInfo as TTypeInfoSet;
-  TIEnum:=nil;
-  if TISet.CompType is TTypeInfoEnum then
-    TIEnum:=TTypeInfoEnum(TISet.CompType);
-  // read value
   o:=TJSObject(GetJSValueProp(Instance,PropInfo));
-  // a set is a JS object, where included element is stored as: o[ElementDecimal]=true
+  Result:=SetToString(PropInfo,o,true);
-  for Key in o do
-  begin
-    n:=parseInt(Key,10);
-    if (TIEnum<>nil) and (n>=TIEnum.MinValue) and (n<=TIEnum.MaxValue) then
-      Value:=TIEnum.EnumType.IntToName[n]
-    else
-      Value:=str(n);
-    if Result<>'' then Result:=Result+',';
-    Result:=Result+Value;
-  end;
-  Result:='['+Result+']';
 end;
 
 function GetSetPropArray(Instance: TObject; const PropName: String
@@ -1622,6 +1604,44 @@ begin
   SetJSValueProp(Instance,PropInfo,Value);
 end;
 
+function SetToString(TypeInfo: TTypeInfo; Value: JSValue; Brackets: Boolean): String;
+var
+  key, v: String;
+  n: NativeInt;
+  TIEnum: TTypeInfoEnum;
+  TISet: TTypeInfoSet;
+begin
+  Result:='';
+  TISet:=TypeInfo as TTypeInfoSet;
+  // get enum type if available
+  TIEnum:=nil;
+  if TISet.CompType is TTypeInfoEnum then
+    TIEnum:=TTypeInfoEnum(TISet.CompType);
+  // a set is a JS object, where included element is stored as: o[ElementDecimal]=true
+  for Key in Value do
+  begin
+    n:=parseInt(Key,10);
+    if (TIEnum<>nil) and (n>=TIEnum.MinValue) and (n<=TIEnum.MaxValue) then
+      v:=TIEnum.EnumType.IntToName[n]
+    else
+      v:=str(n);
+    if Result<>'' then Result:=Result+',';
+    Result:=Result+v;
+  end;
+  if Brackets then
+    Result:='['+Result+']';
+end;
+
+function SetToString(PropInfo: TTypeMemberProperty; Value: JSValue; Brackets: Boolean): String;
+begin
+  Result:=SetToString(PropInfo.TypeInfo, Value, Brackets);
+end;
+
+function SetToString(PropInfo: TTypeMemberProperty; Value: JSValue): String;
+begin
+  Result:=SetToString(PropInfo,Value,False);
+end;
+
 function GetFloatProp(Instance: TObject; PropInfo: TTypeMemberProperty): Double;
 begin
   Result:=Double(GetJSValueProp(Instance,PropInfo));