paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-20 01:22:39 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@40081 -
This commit is contained in:
Mattias Gaertner 2018-10-29 16:41:54 +00:00
parent 3b6436ffe1
commit ddc79efdd4
3 changed files with 67 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
packages/fcl-passrc/tests/tcresolver.pas
View File

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

31
packages/pastojs/src/fppas2js.pp
View File

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

52
packages/pastojs/tests/tcmodules.pas
View File

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