Browse Source

pastojs: typeinfo(intrange type)

git-svn-id: trunk@39167 -
Mattias Gaertner 7 years ago
parent
commit
6d7d4be12f
2 changed files with 47 additions and 1 deletions
  1. 10 1
      packages/pastojs/src/fppas2js.pp
  2. 37 0
      packages/pastojs/tests/tcmodules.pas

+ 10 - 1
packages/pastojs/src/fppas2js.pp

@@ -3756,7 +3756,7 @@ begin
         TIName:=Pas2JSBuiltInNames[pbitnTIDynArray];
         TIName:=Pas2JSBuiltInNames[pbitnTIDynArray];
       end
       end
     else if C=TPasPointerType then
     else if C=TPasPointerType then
-      TIName:=Pas2JSBuiltInNames[pbitnTIPointer]
+      TIName:=Pas2JSBuiltInNames[pbitnTIPointer];
     end
     end
   else if ParamResolved.BaseType=btSet then
   else if ParamResolved.BaseType=btSet then
     begin
     begin
@@ -3768,6 +3768,8 @@ begin
     ConvertRangeToElement(ParamResolved);
     ConvertRangeToElement(ParamResolved);
     if ParamResolved.BaseType in btAllJSInteger then
     if ParamResolved.BaseType in btAllJSInteger then
       TIName:=Pas2JSBuiltInNames[pbitnTIInteger]
       TIName:=Pas2JSBuiltInNames[pbitnTIInteger]
+    else if ParamResolved.BaseType in [btChar,btBoolean] then
+      TIName:=Pas2JSBuiltInNames[pbitnTI]
     else if ParamResolved.BaseType=btContext then
     else if ParamResolved.BaseType=btContext then
       begin
       begin
       TypeEl:=ParamResolved.LoTypeEl;
       TypeEl:=ParamResolved.LoTypeEl;
@@ -3775,6 +3777,13 @@ begin
       if C=TPasEnumType then
       if C=TPasEnumType then
         TIName:=Pas2JSBuiltInNames[pbitnTIEnum];
         TIName:=Pas2JSBuiltInNames[pbitnTIEnum];
       end;
       end;
+    end
+  else if C=TPasRangeType then
+    begin
+    if ParamResolved.BaseType in btAllJSInteger then
+      TIName:=Pas2JSBuiltInNames[pbitnTIInteger]
+    else if ParamResolved.BaseType in [btChar,btBoolean] then
+      TIName:=Pas2JSBuiltInNames[pbitnTI]
     end;
     end;
   //writeln('TPas2JSResolver.BI_TypeInfo_OnGetCallResult TIName=',TIName);
   //writeln('TPas2JSResolver.BI_TypeInfo_OnGetCallResult TIName=',TIName);
   if TIName='' then
   if TIName='' then

+ 37 - 0
packages/pastojs/tests/tcmodules.pas

@@ -634,6 +634,7 @@ type
     Procedure TestJSValue_ForIn;
     Procedure TestJSValue_ForIn;
 
 
     // RTTI
     // RTTI
+    Procedure TestRTTI_IntRange;
     Procedure TestRTTI_ProcType;
     Procedure TestRTTI_ProcType;
     Procedure TestRTTI_ProcType_ArgFromOtherUnit;
     Procedure TestRTTI_ProcType_ArgFromOtherUnit;
     Procedure TestRTTI_EnumAndSetType;
     Procedure TestRTTI_EnumAndSetType;
@@ -18750,6 +18751,42 @@ begin
     '']));
     '']));
 end;
 end;
 
 
+procedure TTestModule.TestRTTI_IntRange;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add([
+  '{$modeswitch externalclass}',
+  'type',
+  '  TTypeInfo = class external name ''rtl.tTypeInfo''',
+  '  end;',
+  '  TTypeInfoInteger = class external name ''rtl.tTypeInfoInteger''(TTypeInfo)',
+  '  end;',
+  '  TGraphicsColor = -$7FFFFFFF-1..$7FFFFFFF;',
+  '  TColor = type TGraphicsColor;',
+  'var',
+  '  p: TTypeInfo;',
+  'begin',
+  '  p:=typeinfo(TGraphicsColor);',
+  '  p:=typeinfo(TColor);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestRTTI_IntRange',
+    LinesToStr([ // statements
+    '$mod.$rtti.$Int("TGraphicsColor", {',
+    '  minvalue: -2147483648,',
+    '  maxvalue: 2147483647,',
+    '  ordtype: 4',
+    '});',
+    '$mod.$rtti.$inherited("TColor", $mod.$rtti["TGraphicsColor"], {});',
+    'this.p = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.p = $mod.$rtti["TGraphicsColor"];',
+    '$mod.p = $mod.$rtti["TColor"];',
+    '']));
+end;
+
 procedure TTestModule.TestRTTI_ProcType;
 procedure TTestModule.TestRTTI_ProcType;
 begin
 begin
   Converter.Options:=Converter.Options-[coNoTypeInfo];
   Converter.Options:=Converter.Options-[coNoTypeInfo];