paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-24 20:58:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: char range literals with non ascii, bug #34925

Browse Source 
git-svn-id: trunk@41058 -
This commit is contained in:
Mattias Gaertner 2019-01-24 17:12:51 +00:00
parent b71f815a9a
commit c67c51fdb5
2 changed files with 75 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
packages/fcl-passrc/src/pasresolveeval.pas
View File

@ -3890,6 +3890,8 @@ end;
function TResExprEvaluator.ExprStringToOrd(Value: TResEvalValue;
PosEl: TPasElement): longword;
const
Invalid = $12345678; // bigger than $ffff and smaller than $8000000
var
{$ifdef FPC_HAS_CPSTRING}
S: RawByteString;
@ -3901,11 +3903,29 @@ begin
begin
// ord(ansichar)
S:=TResEvalString(Value).S;
if length(S)<>1 then
if length(S)=1 then
Result:=ord(S[1])
else if (length(S)=0) or (length(S)>4) then
begin
if PosEl<>nil then
RaiseMsg(20170522221143,nXExpectedButYFound,sXExpectedButYFound,
['char','string'],PosEl)
else
Result:=ord(S[1]);
exit(Invalid);
end
else
begin
U:=GetUnicodeStr(S,nil);
if length(U)<>1 then
begin
if PosEl<>nil then
RaiseMsg(20190124180407,nXExpectedButYFound,sXExpectedButYFound,
['char','string'],PosEl)
else
exit(Invalid);
end;
Result:=ord(U[1]);
end;
end
else
{$endif}
@ -3914,8 +3934,13 @@ begin
// ord(widechar)
U:=TResEvalUTF16(Value).S;
if length(U)<>1 then
begin
if PosEl<>nil then
RaiseMsg(20170522221358,nXExpectedButYFound,sXExpectedButYFound,
['char','string'],PosEl)
else
exit(Invalid);
end
else
Result:=ord(U[1]);
end
@ -4555,35 +4580,35 @@ end;
function TResExprEvaluator.OrdValue(Value: TResEvalValue; ErrorEl: TPasElement
): TResEvalValue;
var
v: longword;
begin
Result:=nil;
v:=0;
case Value.Kind of
revkBool:
if TResEvalBool(Value).B then
Result:=TResEvalInt.CreateValue(1)
v:=1
else
Result:=TResEvalInt.CreateValue(0);
v:=0;
revkInt,revkUInt:
Result:=Value;
exit(Value);
{$ifdef FPC_HAS_CPSTRING}
revkString:
if length(TResEvalString(Value).S)<>1 then
RaiseRangeCheck(20170624160128,ErrorEl)
else
Result:=TResEvalInt.CreateValue(ord(TResEvalString(Value).S[1]));
v:=ExprStringToOrd(Value,ErrorEl);
{$endif}
revkUnicodeString:
if length(TResEvalUTF16(Value).S)<>1 then
RaiseRangeCheck(20170624160129,ErrorEl)
else
Result:=TResEvalInt.CreateValue(ord(TResEvalUTF16(Value).S[1]));
v:=ExprStringToOrd(Value,ErrorEl);
revkEnum:
Result:=TResEvalInt.CreateValue(TResEvalEnum(Value).Index);
v:=TResEvalEnum(Value).Index;
else
{$IFDEF VerbosePasResEval}
writeln('TResExprEvaluator.OrdValue ',Value.AsDebugString);
{$ENDIF}
RaiseNotYetImplemented(20170624155932,ErrorEl);
end;
if v>$ffff then exit;
Result:=TResEvalInt.CreateValue(v);
end;
procedure TResExprEvaluator.PredValue(Value: TResEvalValue; ErrorEl: TPasElement

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

@ -393,6 +393,7 @@ type
Procedure TestCaseOfNoElse_UseSwitch;
Procedure TestCaseOfRange;
Procedure TestCaseOfString;
Procedure TestCaseOfChar;
Procedure TestCaseOfExternalClassConst;
Procedure TestDebugger;
@ -6797,6 +6798,7 @@ begin
'begin',
' for c:=''a'' to ''c'' do ;',
' for c:=c downto ''a'' do ;',
' for c:=''Б'' to ''Я'' do ;',
'']);
ConvertProgram;
CheckSource('TestForCharDo',
@ -6805,6 +6807,7 @@ begin
LinesToStr([ // this.$main
'for (var $l1 = 97; $l1 <= 99; $l1++) $mod.c = String.fromCharCode($l1);',
'for (var $l2 = $mod.c.charCodeAt(); $l2 >= 97; $l2--) $mod.c = String.fromCharCode($l2);',
'for (var $l3 = 1041; $l3 <= 1071; $l3++) $mod.c = String.fromCharCode($l3);',
'']));
end;
@ -7564,6 +7567,7 @@ begin
' case s of',
' ''foo'': s:=h;',
' ''a''..''z'': h:=s;',
' ''Б''..''Я'': ;',
' end;',
'']);
ConvertProgram;
@ -7576,7 +7580,34 @@ begin
'var $tmp1 = $mod.s;',
'if ($tmp1 === "foo") {',
' $mod.s = $mod.h}',
' else if (($tmp1.length === 1) && ($tmp1 >= "a") && ($tmp1 <= "z")) $mod.h = $mod.s;',
' else if (($tmp1.length === 1) && ($tmp1 >= "a") && ($tmp1 <= "z")) {',
' $mod.h = $mod.s}',
' else if (($tmp1.length === 1) && ($tmp1 >= "Б") && ($tmp1 <= "Я")) ;',
'']));
end;
procedure TTestModule.TestCaseOfChar;
begin
StartProgram(false);
Add([
'var s,h: char;',
'begin',
' case s of',
' ''a''..''z'': h:=s;',
' ''Б''..''Я'': ;',
' end;',
'']);
ConvertProgram;
CheckSource('TestCaseOfString',
LinesToStr([ // statements
'this.s = "";',
'this.h = "";',
'']),
LinesToStr([ // $mod.$main
'var $tmp1 = $mod.s;',
'if (($tmp1 >= "a") && ($tmp1 <= "z")) {',
' $mod.h = $mod.s}',
' else if (($tmp1 >= "Б") && ($tmp1 <= "Я")) ;',
'']));
end;