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