Browse Source

pastojs: implemented pred(char), succ(char)

git-svn-id: trunk@40081 -
Mattias Gaertner 6 years ago
parent
commit
ddc79efdd4

+ 14 - 19
packages/fcl-passrc/tests/tcresolver.pas

@@ -238,8 +238,7 @@ type
     Procedure TestInt_ForIn;
 
     // strings
-    Procedure TestChar_Ord;
-    Procedure TestChar_Chr;
+    Procedure TestChar_BuiltInProcs;
     Procedure TestString_SetLength;
     Procedure TestString_Element;
     Procedure TestStringElement_MissingArgFail;
@@ -3158,25 +3157,21 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.TestChar_Ord;
+procedure TTestResolver.TestChar_BuiltInProcs;
 begin
   StartProgram(false);
-  Add('var');
-  Add('  c: char;');
-  Add('  i: longint;');
-  Add('begin');
-  Add('  i:=ord(c);');
-  ParseProgram;
-end;
-
-procedure TTestResolver.TestChar_Chr;
-begin
-  StartProgram(false);
-  Add('var');
-  Add('  c: char;');
-  Add('  i: longint;');
-  Add('begin');
-  Add('  c:=chr(i);');
+  Add([
+  'var',
+  '  c: char;',
+  '  i: longint;',
+  'begin',
+  '  i:=ord(c);',
+  '  c:=chr(i);',
+  '  c:=pred(c);',
+  '  c:=succ(c);',
+  '  c:=low(c);',
+  '  c:=high(c);',
+  '']);
   ParseProgram;
 end;
 

+ 31 - 0
packages/pastojs/src/fppas2js.pp

@@ -9745,8 +9745,10 @@ var
   begin
     V:=ConvertElement(Param,AContext);
     if IsPred then
+      // pred(int) -> Param-1
       Expr:=TJSAdditiveExpressionMinus(CreateElement(TJSAdditiveExpressionMinus,El))
     else
+      // succ(int) -> Param+1
       Expr:=TJSAdditiveExpressionPlus(CreateElement(TJSAdditiveExpressionPlus,El));
     Expr.A:=V;
     Expr.B:=CreateLiteralNumber(El,1);
@@ -9756,11 +9758,35 @@ var
   procedure CreateSwitchBool;
   begin
     if IsPred then
+      // pred(bool) -> false
       ConvertBuiltIn_PredSucc:=CreateLiteralBoolean(El,false)
     else
+      // succ(bool) -> true
       ConvertBuiltIn_PredSucc:=CreateLiteralBoolean(El,true);
   end;
 
+  procedure CreateCharPredSucc(Param: TPasExpr);
+  var
+    V: TJSElement;
+    Call: TJSCallExpression;
+    Expr: TJSAdditiveExpression;
+  begin
+    V:=ConvertElement(Param,AContext);
+    // V.charCodeAt()
+    Call:=CreateCallCharCodeAt(V,0,El);
+    if IsPred then
+      // pred(V) -> V.charCodeAt-1
+      Expr:=TJSAdditiveExpressionMinus(CreateElement(TJSAdditiveExpressionMinus,El))
+    else
+      // succ(V) -> V.charCodeAt+1
+      Expr:=TJSAdditiveExpressionPlus(CreateElement(TJSAdditiveExpressionPlus,El));
+    Expr.A:=Call;
+    Expr.B:=CreateLiteralNumber(El,1);
+    // String.fromCharCode(V.charCodeAt+1)
+    Call:=CreateCallFromCharCode(Expr,El);
+    ConvertBuiltIn_PredSucc:=Call;
+  end;
+
 var
   Param: TPasExpr;
   Value: TResEvalValue;
@@ -9781,6 +9807,11 @@ begin
     CreateSwitchBool;
     exit;
     end
+  else if ResolvedEl.BaseType in btAllJSChars then
+    begin
+    CreateCharPredSucc(Param);
+    exit;
+    end
   else if ResolvedEl.BaseType=btContext then
     begin
     if TypeEl.ClassType=TPasEnumType then

+ 22 - 30
packages/pastojs/tests/tcmodules.pas

@@ -263,8 +263,7 @@ type
     // strings
     Procedure TestCharConst;
     Procedure TestChar_Compare;
-    Procedure TestChar_Ord;
-    Procedure TestChar_Chr;
+    Procedure TestChar_BuiltInProcs;
     Procedure TestStringConst;
     Procedure TestStringConstSurrogate;
     Procedure TestString_Length;
@@ -5803,18 +5802,25 @@ begin
     '']));
 end;
 
-procedure TTestModule.TestChar_Ord;
+procedure TTestModule.TestChar_BuiltInProcs;
 begin
   StartProgram(false);
-  Add('var');
-  Add('  c: char;');
-  Add('  i: longint;');
-  Add('  s: string;');
-  Add('begin');
-  Add('  i:=ord(c);');
-  Add('  i:=ord(s[i]);');
+  Add([
+  'var',
+  '  c: char;',
+  '  i: longint;',
+  '  s: string;',
+  'begin',
+  '  i:=ord(c);',
+  '  i:=ord(s[i]);',
+  '  c:=chr(i);',
+  '  c:=pred(c);',
+  '  c:=succ(c);',
+  '  c:=low(c);',
+  '  c:=high(c);',
+  '']);
   ConvertProgram;
-  CheckSource('TestChar_Ord',
+  CheckSource('TestChar_BuiltInProcs',
     LinesToStr([
     'this.c = "";',
     'this.i = 0;',
@@ -5823,25 +5829,11 @@ begin
     LinesToStr([
     '$mod.i = $mod.c.charCodeAt();',
     '$mod.i = $mod.s.charCodeAt($mod.i-1);',
-    '']));
-end;
-
-procedure TTestModule.TestChar_Chr;
-begin
-  StartProgram(false);
-  Add('var');
-  Add('  c: char;');
-  Add('  i: longint;');
-  Add('begin');
-  Add('  c:=chr(i);');
-  ConvertProgram;
-  CheckSource('TestChar_Chr',
-    LinesToStr([
-    'this.c = "";',
-    'this.i = 0;'
-    ]),
-    LinesToStr([
     '$mod.c = String.fromCharCode($mod.i);',
+    '$mod.c = String.fromCharCode($mod.c.charCodeAt() - 1);',
+    '$mod.c = String.fromCharCode($mod.c.charCodeAt() + 1);',
+    '$mod.c = "\x00";',
+    '$mod.c = "\uFFFF";',
     '']));
 end;
 
@@ -7209,7 +7201,7 @@ begin
     '']),
     LinesToStr([ // $mod.$main
     '$mod.c = "\x00";',
-    '$mod.c = "'#$EF#$BF#$BF'";',
+    '$mod.c = "\uFFFF";',
     '$mod.Arr[66] = "a";',
     '$mod.Arr[68] = $mod.Arr[$mod.c.charCodeAt()];',
     '$mod.Arr[$mod.c.charCodeAt()] = $mod.Arr[100];',