paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 06:49:23 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: adapted pasresolveeval for pas2js

Browse Source 
git-svn-id: trunk@39946 -
This commit is contained in:
Mattias Gaertner 2018-10-16 10:48:56 +00:00
parent 4c0a213f0d
commit a70f58f68e
1 changed files with 107 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -352,13 +352,18 @@ type
revkUInt, // TResEvalUInt revkUInt, // TResEvalUInt
revkFloat, // TResEvalFloat revkFloat, // TResEvalFloat
revkCurrency, // TResEvalCurrency revkCurrency, // TResEvalCurrency
revkString, // TResEvalString {$ifdef FPC_HAS_CPSTRING}
revkString, // TResEvalString rawbytestring
{$endif}
revkUnicodeString, // TResEvalUTF16 revkUnicodeString, // TResEvalUTF16
revkEnum, // TResEvalEnum revkEnum, // TResEvalEnum
revkRangeInt, // range of enum, int, char, widechar, e.g. 1..2 revkRangeInt, // range of enum, int, char, widechar, e.g. 1..2
revkRangeUInt, // range of uint, e.g. 1..2 revkRangeUInt, // range of uint, e.g. 1..2
revkSetOfInt // set of enum, int, char, widechar, e.g. [1,2..3] revkSetOfInt // set of enum, int, char, widechar, e.g. [1,2..3]
); );
const
revkAllStrings = [{$ifdef FPC_HAS_CPSTRING}revkString,{$endif}revkUnicodeString];
type
TResEvalValue = class(TResolveData) TResEvalValue = class(TResolveData)
public public
Kind: TREVKind; Kind: TREVKind;
@ -1419,10 +1424,13 @@ begin
TResEvalEnum(LeftValue).Index,TResEvalEnum(RightValue).Index); TResEvalEnum(LeftValue).Index,TResEvalEnum(RightValue).Index);
exit; exit;
end; end;
revkString,revkUnicodeString: {$ifdef FPC_HAS_CPSTRING}
revkString,
{$endif}
revkUnicodeString:
begin begin
LeftInt:=ExprStringToOrd(LeftValue,Expr.left); LeftInt:=ExprStringToOrd(LeftValue,Expr.left);
if RightValue.Kind in [revkString,revkUnicodeString] then if RightValue.Kind in revkAllStrings then
begin begin
RightInt:=ExprStringToOrd(RightValue,Expr.right); RightInt:=ExprStringToOrd(RightValue,Expr.right);
if LeftInt>RightInt then if LeftInt>RightInt then
@ -1469,13 +1477,15 @@ var
UInt: TMaxPrecUInt; UInt: TMaxPrecUInt;
Flo: TMaxPrecFloat; Flo: TMaxPrecFloat;
aCurrency: TMaxPrecCurrency; aCurrency: TMaxPrecCurrency;
{$ifdef FPC_HAS_CPSTRING}
LeftCP, RightCP: TSystemCodePage; LeftCP, RightCP: TSystemCodePage;
{$endif}
LeftSet, RightSet: TResEvalSet; LeftSet, RightSet: TResEvalSet;
i: Integer; i: Integer;
begin begin
Result:=nil; Result:=nil;
try try
{$Q+} {$Q+} // enable overflow and range checks
{$R+} {$R+}
case LeftValue.Kind of case LeftValue.Kind of
revkInt: revkInt:
@ -1566,6 +1576,7 @@ begin
RaiseNotYetImplemented(20180421163819,Expr); RaiseNotYetImplemented(20180421163819,Expr);
end; end;
end; end;
{$ifdef FPC_HAS_CPSTRING}
revkString: revkString:
case RightValue.Kind of case RightValue.Kind of
revkString: revkString:
@ -1596,14 +1607,17 @@ begin
{$ENDIF} {$ENDIF}
RaiseNotYetImplemented(20170601141834,Expr); RaiseNotYetImplemented(20170601141834,Expr);
end; end;
{$endif}
revkUnicodeString: revkUnicodeString:
case RightValue.Kind of case RightValue.Kind of
{$ifdef FPC_HAS_CPSTRING}
revkString: revkString:
begin begin
Result:=TResEvalUTF16.Create; Result:=TResEvalUTF16.Create;
TResEvalUTF16(Result).S:=TResEvalUTF16(LeftValue).S TResEvalUTF16(Result).S:=TResEvalUTF16(LeftValue).S
+GetUnicodeStr(TResEvalString(RightValue).S,Expr.right); +GetUnicodeStr(TResEvalString(RightValue).S,Expr.right);
end; end;
{$endif}
revkUnicodeString: revkUnicodeString:
begin begin
Result:=TResEvalUTF16.Create; Result:=TResEvalUTF16.Create;
@ -2807,6 +2821,7 @@ begin
Result.Free; Result.Free;
RaiseNotYetImplemented(20180421165438,Expr); RaiseNotYetImplemented(20180421165438,Expr);
end; end;
{$ifdef FPC_HAS_CPSTRING}
revkString: revkString:
case RightValue.Kind of case RightValue.Kind of
revkString: revkString:
@ -2825,11 +2840,14 @@ begin
Result.Free; Result.Free;
RaiseNotYetImplemented(20170711175409,Expr); RaiseNotYetImplemented(20170711175409,Expr);
end; end;
{$endif}
revkUnicodeString: revkUnicodeString:
case RightValue.Kind of case RightValue.Kind of
{$ifdef FPC_HAS_CPSTRING}
revkString: revkString:
TResEvalBool(Result).B:=TResEvalUTF16(LeftValue).S TResEvalBool(Result).B:=TResEvalUTF16(LeftValue).S
=GetUnicodeStr(TResEvalString(RightValue).S,Expr.right); =GetUnicodeStr(TResEvalString(RightValue).S,Expr.right);
{$endif}
revkUnicodeString: revkUnicodeString:
TResEvalBool(Result).B:=TResEvalUTF16(LeftValue).S TResEvalBool(Result).B:=TResEvalUTF16(LeftValue).S
=TResEvalUTF16(RightValue).S; =TResEvalUTF16(RightValue).S;
@ -3128,6 +3146,7 @@ begin
Result.Free; Result.Free;
RaiseNotYetImplemented(20180421165752,Expr); RaiseNotYetImplemented(20180421165752,Expr);
end; end;
{$ifdef FPC_HAS_CPSTRING}
revkString: revkString:
case RightValue.Kind of case RightValue.Kind of
revkString: revkString:
@ -3155,11 +3174,14 @@ begin
Result.Free; Result.Free;
RaiseNotYetImplemented(20170711175629,Expr); RaiseNotYetImplemented(20170711175629,Expr);
end; end;
{$endif}
revkUnicodeString: revkUnicodeString:
case RightValue.Kind of case RightValue.Kind of
{$ifdef FPC_HAS_CPSTRING}
revkString: revkString:
CmpUnicode(TResEvalUTF16(LeftValue).S, CmpUnicode(TResEvalUTF16(LeftValue).S,
GetUnicodeStr(TResEvalString(RightValue).S,Expr.right)); GetUnicodeStr(TResEvalString(RightValue).S,Expr.right));
{$endif}
revkUnicodeString: revkUnicodeString:
CmpUnicode(TResEvalUTF16(LeftValue).S,TResEvalUTF16(RightValue).S); CmpUnicode(TResEvalUTF16(LeftValue).S,TResEvalUTF16(RightValue).S);
else else
@ -3264,12 +3286,14 @@ begin
RaiseMsg(20170714123700,nRangeCheckError,sRangeCheckError,[],Expr) RaiseMsg(20170714123700,nRangeCheckError,sRangeCheckError,[],Expr)
else else
Int:=TResEvalUInt(LeftValue).UInt; Int:=TResEvalUInt(LeftValue).UInt;
{$ifdef FPC_HAS_CPSTRING}
revkString: revkString:
if length(TResEvalString(LeftValue).S)<>1 then if length(TResEvalString(LeftValue).S)<>1 then
RaiseMsg(20170714124231,nXExpectedButYFound,sXExpectedButYFound, RaiseMsg(20170714124231,nXExpectedButYFound,sXExpectedButYFound,
['char','string'],Expr) ['char','string'],Expr)
else else
Int:=ord(TResEvalString(LeftValue).S[1]); Int:=ord(TResEvalString(LeftValue).S[1]);
{$endif}
revkUnicodeString: revkUnicodeString:
if length(TResEvalUTF16(LeftValue).S)<>1 then if length(TResEvalUTF16(LeftValue).S)<>1 then
RaiseMsg(20170714124320,nXExpectedButYFound,sXExpectedButYFound, RaiseMsg(20170714124320,nXExpectedButYFound,sXExpectedButYFound,
@ -3387,7 +3411,10 @@ begin
IndexValue:=nil; IndexValue:=nil;
try try
case ArrayValue.Kind of case ArrayValue.Kind of
revkString,revkUnicodeString: {$ifdef FPC_HAS_CPSTRING}
revkString,
{$endif}
revkUnicodeString:
begin begin
// string[index] // string[index]
Param0:=Expr.Params[0]; Param0:=Expr.Params[0];
@ -3412,15 +3439,19 @@ begin
{$ENDIF} {$ENDIF}
RaiseNotYetImplemented(20170711182100,Expr); RaiseNotYetImplemented(20170711182100,Expr);
end; end;
{$ifdef FPC_HAS_CPSTRING}
if ArrayValue.Kind=revkString then if ArrayValue.Kind=revkString then
MaxIndex:=length(TResEvalString(ArrayValue).S) MaxIndex:=length(TResEvalString(ArrayValue).S)
else else
{$endif}
MaxIndex:=length(TResEvalUTF16(ArrayValue).S); MaxIndex:=length(TResEvalUTF16(ArrayValue).S);
if (Int<1) or (Int>MaxIndex) then if (Int<1) or (Int>MaxIndex) then
EmitRangeCheckConst(20170711183058,IntToStr(Int),'1',IntToStr(MaxIndex),Param0,mtError); EmitRangeCheckConst(20170711183058,IntToStr(Int),'1',IntToStr(MaxIndex),Param0,mtError);
{$ifdef FPC_HAS_CPSTRING}
if ArrayValue.Kind=revkString then if ArrayValue.Kind=revkString then
Result:=TResEvalString.CreateValue(TResEvalString(ArrayValue).S[Int]) Result:=TResEvalString.CreateValue(TResEvalString(ArrayValue).S[Int])
else else
{$endif}
Result:=TResEvalUTF16.CreateValue(TResEvalUTF16(ArrayValue).S[Int]); Result:=TResEvalUTF16.CreateValue(TResEvalUTF16(ArrayValue).S[Int]);
exit; exit;
end; end;
@ -3514,6 +3545,7 @@ begin
RangeStart:=TResEvalUInt(Value).UInt; RangeStart:=TResEvalUInt(Value).UInt;
RangeEnd:=RangeStart; RangeEnd:=RangeStart;
end; end;
{$ifdef FPC_HAS_CPSTRING}
revkString: revkString:
begin begin
if Result.ElKind=revskNone then if Result.ElKind=revskNone then
@ -3529,6 +3561,7 @@ begin
RangeStart:=ord(TResEvalString(Value).S[1]); RangeStart:=ord(TResEvalString(Value).S[1]);
RangeEnd:=RangeStart; RangeEnd:=RangeStart;
end; end;
{$endif}
revkUnicodeString: revkUnicodeString:
begin begin
if Result.ElKind=revskNone then if Result.ElKind=revskNone then
@ -3837,9 +3870,12 @@ end;
function TResExprEvaluator.ExprStringToOrd(Value: TResEvalValue; function TResExprEvaluator.ExprStringToOrd(Value: TResEvalValue;
PosEl: TPasElement): longword; PosEl: TPasElement): longword;
var var
{$ifdef FPC_HAS_CPSTRING}
S: RawByteString; S: RawByteString;
{$endif}
U: UnicodeString; U: UnicodeString;
begin begin
{$ifdef FPC_HAS_CPSTRING}
if Value.Kind=revkString then if Value.Kind=revkString then
begin begin
// ord(ansichar) // ord(ansichar)
@ -3850,7 +3886,9 @@ begin
else else
Result:=ord(S[1]); Result:=ord(S[1]);
end end
else if Value.Kind=revkUnicodeString then else
{$endif}
if Value.Kind=revkUnicodeString then
begin begin
// ord(widechar) // ord(widechar)
U:=TResEvalUTF16(Value).S; U:=TResEvalUTF16(Value).S;
@ -3884,15 +3922,18 @@ function TResExprEvaluator.EvalPrimitiveExprString(Expr: TPrimitiveExpr
procedure Add(h: String); procedure Add(h: String);
begin begin
{$ifdef FPC_HAS_CPSTRING}
if Result.Kind=revkString then if Result.Kind=revkString then
TResEvalString(Result).S:=TResEvalString(Result).S+h TResEvalString(Result).S:=TResEvalString(Result).S+h
else else
begin
TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+GetUnicodeStr(h,Expr); TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+GetUnicodeStr(h,Expr);
end; {$else}
TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+h;
{$endif}
end; end;
procedure AddHash(u: longword); procedure AddHash(u: longword);
{$ifdef FPC_HAS_CPSTRING}
var var
h: RawByteString; h: RawByteString;
begin begin
@ -3909,9 +3950,14 @@ function TResExprEvaluator.EvalPrimitiveExprString(Expr: TPrimitiveExpr
else else
TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+WideChar(u); TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+WideChar(u);
end; end;
{$else}
begin
TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+WideChar(u);
end;
{$endif}
var var
p, StartP: PChar; p, StartP, l: integer;
c: Char; c: Char;
u: longword; u: longword;
S: String; S: String;
@ -3921,29 +3967,36 @@ begin
{$IFDEF VerbosePasResEval} {$IFDEF VerbosePasResEval}
//writeln('TResExprEvaluator.EvalPrimitiveExprString (',S,')'); //writeln('TResExprEvaluator.EvalPrimitiveExprString (',S,')');
{$ENDIF} {$ENDIF}
if S='' then l:=length(S);
if l=0 then
RaiseInternalError(20170523113809); RaiseInternalError(20170523113809);
{$ifdef FPC_HAS_CPSTRING}
Result:=TResEvalString.Create; Result:=TResEvalString.Create;
p:=PChar(S); {$else}
repeat Result:=TResEvalUTF16.Create;
case p^ of {$endif}
p:=1;
while p<=l do
case S[p] of
{$ifdef UsePChar}
#0: break; #0: break;
{$endif}
'''': '''':
begin begin
inc(p); inc(p);
StartP:=p; StartP:=p;
repeat repeat
c:=p^; if p>l then
case c of
#0:
RaiseInternalError(20170523113938); RaiseInternalError(20170523113938);
c:=S[p];
case c of
'''': '''':
begin begin
if p>StartP then if p>StartP then
Add(copy(S,StartP-PChar(S)+1,p-StartP)); Add(copy(S,StartP,p-StartP));
inc(p); inc(p);
StartP:=p; StartP:=p;
if p^<>'''' then if (p>l) or (S[p]<>'''') then
break; break;
Add(''''); Add('''');
inc(p); inc(p);
@ -3954,21 +4007,23 @@ begin
end; end;
until false; until false;
if p>StartP then if p>StartP then
Add(copy(S,StartP-PChar(S)+1,p-StartP)); Add(copy(S,StartP,p-StartP));
end; end;
'#': '#':
begin begin
inc(p); inc(p);
if p^='$' then if p>l then
RaiseInternalError(20181016121354);
if S[p]='$' then
begin begin
// #$hexnumber // #$hexnumber
inc(p); inc(p);
StartP:=p; StartP:=p;
u:=0; u:=0;
repeat while p<=l do
c:=p^; begin
c:=S[p];
case c of case c of
#0: break;
'0'..'9': u:=u*16+ord(c)-ord('0'); '0'..'9': u:=u*16+ord(c)-ord('0');
'a'..'f': u:=u*16+ord(c)-ord('a')+10; 'a'..'f': u:=u*16+ord(c)-ord('a')+10;
'A'..'F': u:=u*16+ord(c)-ord('A')+10; 'A'..'F': u:=u*16+ord(c)-ord('A')+10;
@ -3977,7 +4032,7 @@ begin
if u>$10FFFF then if u>$10FFFF then
RangeError(20170523115712); RangeError(20170523115712);
inc(p); inc(p);
until false; end;
if p=StartP then if p=StartP then
RaiseInternalError(20170207164956); RaiseInternalError(20170207164956);
if u>$ffff then if u>$ffff then
@ -3995,17 +4050,17 @@ begin
// #decimalnumber // #decimalnumber
StartP:=p; StartP:=p;
u:=0; u:=0;
repeat while p<=l do
c:=p^; begin
c:=S[p];
case c of case c of
#0: break;
'0'..'9': u:=u*10+ord(c)-ord('0'); '0'..'9': u:=u*10+ord(c)-ord('0');
else break; else break;
end; end;
if u>$ffff then if u>$ffff then
RangeError(20170523123137); RangeError(20170523123137);
inc(p); inc(p);
until false; end;
if p=StartP then if p=StartP then
RaiseInternalError(20170523123806); RaiseInternalError(20170523123806);
AddHash(u); AddHash(u);
@ -4015,7 +4070,9 @@ begin
begin begin
// ^A is #1 // ^A is #1
inc(p); inc(p);
c:=p^; if p>l then
RaiseInternalError(20181016121520);
c:=S[p];
case c of case c of
'a'..'z': AddHash(ord(c)-ord('a')+1); 'a'..'z': AddHash(ord(c)-ord('a')+1);
'A'..'Z': AddHash(ord(c)-ord('A')+1); 'A'..'Z': AddHash(ord(c)-ord('A')+1);
@ -4024,9 +4081,8 @@ begin
inc(p); inc(p);
end; end;
else else
RaiseNotYetImplemented(20170523123815,Expr,'ord='+IntToStr(ord(p^))); RaiseNotYetImplemented(20170523123815,Expr,'ord='+IntToStr(ord(S[p])));
end; end;
until false;
{$IFDEF VerbosePasResEval} {$IFDEF VerbosePasResEval}
//writeln('TResExprEvaluator.EvalPrimitiveExprString Result=',Result.AsString); //writeln('TResExprEvaluator.EvalPrimitiveExprString Result=',Result.AsString);
{$ENDIF} {$ENDIF}
@ -4044,7 +4100,9 @@ constructor TResExprEvaluator.Create;
begin begin
inherited Create; inherited Create;
FAllowedInts:=ReitDefaults; FAllowedInts:=ReitDefaults;
{$ifdef FPC_HAS_CPSTRING}
FDefaultEncoding:=CP_ACP; FDefaultEncoding:=CP_ACP;
{$endif}
end; end;
function TResExprEvaluator.Eval(Expr: TPasExpr; Flags: TResEvalFlags function TResExprEvaluator.Eval(Expr: TPasExpr; Flags: TResEvalFlags
@ -4253,7 +4311,7 @@ begin
RaiseNotYetImplemented(20170522215906,ValueExpr); RaiseNotYetImplemented(20170522215906,ValueExpr);
end; end;
revskChar: revskChar:
if Value.Kind in [revkString,revkUnicodeString] then if Value.Kind in revkAllStrings then
begin begin
// string in char..char // string in char..char
CharIndex:=ExprStringToOrd(Value,ValueExpr); CharIndex:=ExprStringToOrd(Value,ValueExpr);
@ -4450,10 +4508,12 @@ begin
Int:=TResEvalInt(Value).Int; Int:=TResEvalInt(Value).Int;
if (Int<0) or (Int>$ffff) then if (Int<0) or (Int>$ffff) then
EmitRangeCheckConst(20170711195747,Value.AsString,0,$ffff,ErrorEl,mtError); EmitRangeCheckConst(20170711195747,Value.AsString,0,$ffff,ErrorEl,mtError);
if Int>$ff then {$ifdef FPC_HAS_CPSTRING}
Result:=TResEvalUTF16.CreateValue(WideChar(Int)) if Int<=$ff then
Result:=TResEvalString.CreateValue(chr(Int))
else else
Result:=TResEvalString.CreateValue(chr(Int)); {$endif}
Result:=TResEvalUTF16.CreateValue(WideChar(Int))
end; end;
else else
{$IFDEF VerbosePasResEval} {$IFDEF VerbosePasResEval}
@ -4474,11 +4534,13 @@ begin
Result:=TResEvalInt.CreateValue(0); Result:=TResEvalInt.CreateValue(0);
revkInt,revkUInt: revkInt,revkUInt:
Result:=Value; Result:=Value;
{$ifdef FPC_HAS_CPSTRING}
revkString: revkString:
if length(TResEvalString(Value).S)<>1 then if length(TResEvalString(Value).S)<>1 then
RaiseRangeCheck(20170624160128,ErrorEl) RaiseRangeCheck(20170624160128,ErrorEl)
else else
Result:=TResEvalInt.CreateValue(ord(TResEvalString(Value).S[1])); Result:=TResEvalInt.CreateValue(ord(TResEvalString(Value).S[1]));
{$endif}
revkUnicodeString: revkUnicodeString:
if length(TResEvalUTF16(Value).S)<>1 then if length(TResEvalUTF16(Value).S)<>1 then
RaiseRangeCheck(20170624160129,ErrorEl) RaiseRangeCheck(20170624160129,ErrorEl)
@ -4504,8 +4566,10 @@ begin
PredInt(TResEvalInt(Value),ErrorEl); PredInt(TResEvalInt(Value),ErrorEl);
revkUInt: revkUInt:
PredUInt(TResEvalUInt(Value),ErrorEl); PredUInt(TResEvalUInt(Value),ErrorEl);
{$ifdef FPC_HAS_CPSTRING}
revkString: revkString:
PredString(TResEvalString(Value),ErrorEl); PredString(TResEvalString(Value),ErrorEl);
{$endif}
revkUnicodeString: revkUnicodeString:
PredUnicodeString(TResEvalUTF16(Value),ErrorEl); PredUnicodeString(TResEvalUTF16(Value),ErrorEl);
revkEnum: revkEnum:
@ -4529,8 +4593,10 @@ begin
SuccInt(TResEvalInt(Value),ErrorEl); SuccInt(TResEvalInt(Value),ErrorEl);
revkUInt: revkUInt:
SuccUInt(TResEvalUInt(Value),ErrorEl); SuccUInt(TResEvalUInt(Value),ErrorEl);
{$ifdef FPC_HAS_CPSTRING}
revkString: revkString:
SuccString(TResEvalString(Value),ErrorEl); SuccString(TResEvalString(Value),ErrorEl);
{$endif}
revkUnicodeString: revkUnicodeString:
SuccUnicodeString(TResEvalUTF16(Value),ErrorEl); SuccUnicodeString(TResEvalUTF16(Value),ErrorEl);
revkEnum: revkEnum:
@ -4639,7 +4705,7 @@ begin
begin begin
ValStr:=TResEvalEnum(Value).AsString; ValStr:=TResEvalEnum(Value).AsString;
if Format1>0 then if Format1>0 then
ValStr:=Space(Format1)+ValStr; ValStr:=StringOfChar(' ',Format1)+ValStr;
end; end;
else else
AllConst:=false; AllConst:=false;
@ -4653,7 +4719,11 @@ begin
S:=S+ValStr; S:=S+ValStr;
end; end;
if AllConst then if AllConst then
{$ifdef FPC_HAS_CPSTRING}
Result:=TResEvalString.CreateValue(S); Result:=TResEvalString.CreateValue(S);
{$else}
Result:=TResEvalUTF16.CreateValue(S);
{$endif}
end; end;
function TResExprEvaluator.EnumTypeCast(EnumType: TPasEnumType; Expr: TPasExpr; function TResExprEvaluator.EnumTypeCast(EnumType: TPasEnumType; Expr: TPasExpr;
@ -5545,6 +5615,7 @@ begin
exit(l) exit(l)
else else
exit(m); exit(m);
Result:=-1;
end; end;
function TResEvalSet.Intersects(aRangeStart, aRangeEnd: TMaxPrecInt): integer; function TResEvalSet.Intersects(aRangeStart, aRangeEnd: TMaxPrecInt): integer;