Ver código fonte

pastojs: enumrange in set

git-svn-id: trunk@47050 -
Mattias Gaertner 4 anos atrás
pai
commit
301809cc4a
2 arquivos alterados com 36 adições e 24 exclusões
  1. 10 5
      packages/pastojs/src/fppas2js.pp
  2. 26 19
      packages/pastojs/tests/tcmodules.pas

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

@@ -23384,6 +23384,8 @@ var
   Call: TJSCallExpression;
   DotExpr: TJSDotMemberExpression;
   aResolver: TPas2JSResolver;
+  bt: TResolverBaseType;
+  C: TClass;
 begin
   Result:=ConvertExpression(Expr,AContext);
   if Result=nil then
@@ -23437,19 +23439,22 @@ begin
   if aResolver<>nil then
     begin
     aResolver.ComputeElement(Expr,ExprResolved,[]);
-    if (ExprResolved.BaseType in btAllJSStringAndChars)
-        or ((ExprResolved.BaseType=btRange) and (ExprResolved.SubType in btAllJSChars)) then
+    bt:=ExprResolved.BaseType;
+    if bt=btRange then
+      bt:=ExprResolved.SubType;
+    if bt in btAllJSStringAndChars then
       begin
       // aChar -> aChar.charCodeAt()
       Result:=CreateCallCharCodeAt(Result,0,Expr);
       end
-    else if ExprResolved.BaseType in btAllJSInteger then
+    else if bt in btAllJSInteger then
       begin
       // ok
       end
-    else if ExprResolved.BaseType=btContext then
+    else if bt=btContext then
       begin
-      if ExprResolved.LoTypeEl.ClassType=TPasEnumType then
+      C:=ExprResolved.LoTypeEl.ClassType;
+      if (C=TPasEnumType) or (C=TPasRangeType) then
         // ok
       else
         RaiseNotSupported(Expr,AContext,20170415191933);

+ 26 - 19
packages/pastojs/tests/tcmodules.pas

@@ -5910,23 +5910,28 @@ end;
 procedure TTestModule.TestSet_Operator_In;
 begin
   StartProgram(false);
-  Add('type');
-  Add('  TColor = (Red, Green, Blue);');
-  Add('  TColors = set of tcolor;');
-  Add('var');
-  Add('  vC: tcolor;');
-  Add('  vT: tcolors;');
-  Add('  B: boolean;');
-  Add('begin');
-  Add('  b:=red in vt;');
-  Add('  b:=vc in vt;');
-  Add('  b:=green in [red..blue];');
-  Add('  b:=vc in [red..blue];');
-  Add('  ');
-  Add('  if red in vt then ;');
-  Add('  while vC in vt do ;');
-  Add('  repeat');
-  Add('  until vC in vt;');
+  Add([
+  'type',
+  '  TColor = (Red, Green, Blue);',
+  '  TColors = set of tcolor;',
+  '  TColorRg = green..blue;',
+  'var',
+  '  vC: tcolor;',
+  '  vT: tcolors;',
+  '  B: boolean;',
+  '  rg: TColorRg;',
+  'begin',
+  '  b:=red in vt;',
+  '  b:=vc in vt;',
+  '  b:=green in [red..blue];',
+  '  b:=vc in [red..blue];',
+  '  ',
+  '  if red in vt then ;',
+  '  while vC in vt do ;',
+  '  repeat',
+  '  until vC in vt;',
+  '  if rg in [green..blue] then ;',
+  '']);
   ConvertProgram;
   CheckSource('TestSet_Operator_In',
     LinesToStr([ // statements
@@ -5940,8 +5945,9 @@ begin
     '  };',
     'this.vC = 0;',
     'this.vT = {};',
-    'this.B = false;'
-    ]),
+    'this.B = false;',
+    'this.rg = this.TColor.Green;',
+    '']),
     LinesToStr([
     '$mod.B = $mod.TColor.Red in $mod.vT;',
     '$mod.B = $mod.vC in $mod.vT;',
@@ -5952,6 +5958,7 @@ begin
     '};',
     'do {',
     '} while (!($mod.vC in $mod.vT));',
+    'if ($mod.rg in rtl.createSet(null, $mod.TColor.Green, $mod.TColor.Blue)) ;',
     '']));
 end;