paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-27 18:21:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: resolver: eval const strings, enums, sets

Browse Source 
git-svn-id: trunk@36730 -
This commit is contained in:
Mattias Gaertner 2017-07-14 11:47:48 +00:00
parent 92405e640a
commit 6dcd2db78c
4 changed files with 1244 additions and 276 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

File diff suppressed because it is too large Load Diff

235
packages/fcl-passrc/src/pasresolver.pp
View File

@ -153,6 +153,7 @@ ToDo:
- indexedprop[param] - indexedprop[param]
- a:=value - a:=value
- set+set, set*set, set-set - set+set, set*set, set-set
- case-of unique
- @@ - @@
- fail to write a loop var inside the loop - fail to write a loop var inside the loop
- warn: create class with abstract methods - warn: create class with abstract methods
@ -279,6 +280,7 @@ const
btAllStringAndChars = btAllStrings+btAllChars; btAllStringAndChars = btAllStrings+btAllChars;
btAllFloats = [btSingle,btDouble,btExtended,btCExtended,btCurrency]; btAllFloats = [btSingle,btDouble,btExtended,btCExtended,btCurrency];
btAllBooleans = [btBoolean,btByteBool,btWordBool,btLongBool,btQWordBool]; btAllBooleans = [btBoolean,btByteBool,btWordBool,btLongBool,btQWordBool];
btAllRanges = btAllInteger+btAllBooleans+btAllChars;
btAllStandardTypes = [ btAllStandardTypes = [
btChar, btChar,
btAnsiChar, btAnsiChar,
@ -838,7 +840,7 @@ type
TOnGetCallResult = procedure(Proc: TResElDataBuiltInProc; Params: TParamsExpr; TOnGetCallResult = procedure(Proc: TResElDataBuiltInProc; Params: TParamsExpr;
out ResolvedEl: TPasResolverResult) of object; out ResolvedEl: TPasResolverResult) of object;
TOnEvalBIFunction = procedure(Proc: TResElDataBuiltInProc; Params: TParamsExpr; TOnEvalBIFunction = procedure(Proc: TResElDataBuiltInProc; Params: TParamsExpr;
out Evaluated: TResEvalValue) of object; Flags: TResEvalFlags; out Evaluated: TResEvalValue) of object;
TOnFinishParamsExpr = procedure(Proc: TResElDataBuiltInProc; TOnFinishParamsExpr = procedure(Proc: TResElDataBuiltInProc;
Params: TParamsExpr) of object; Params: TParamsExpr) of object;
@ -1105,7 +1107,7 @@ type
procedure BI_Length_OnGetCallResult(Proc: TResElDataBuiltInProc; procedure BI_Length_OnGetCallResult(Proc: TResElDataBuiltInProc;
Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual; Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
procedure BI_Length_OnEval(Proc: TResElDataBuiltInProc; procedure BI_Length_OnEval(Proc: TResElDataBuiltInProc;
Params: TParamsExpr; out Evaluated: TResEvalValue); virtual; Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
function BI_SetLength_OnGetCallCompatibility(Proc: TResElDataBuiltInProc; function BI_SetLength_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
Expr: TPasExpr; RaiseOnError: boolean): integer; virtual; Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
procedure BI_SetLength_OnFinishParamsExpr(Proc: TResElDataBuiltInProc; procedure BI_SetLength_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
@ -1132,24 +1134,26 @@ type
Expr: TPasExpr; RaiseOnError: boolean): integer; virtual; Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
procedure BI_Chr_OnGetCallResult(Proc: TResElDataBuiltInProc; procedure BI_Chr_OnGetCallResult(Proc: TResElDataBuiltInProc;
{%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual; {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
procedure BI_Chr_OnEval(Proc: TResElDataBuiltInProc;
Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
function BI_Ord_OnGetCallCompatibility(Proc: TResElDataBuiltInProc; function BI_Ord_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
Expr: TPasExpr; RaiseOnError: boolean): integer; virtual; Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
procedure BI_Ord_OnGetCallResult(Proc: TResElDataBuiltInProc; procedure BI_Ord_OnGetCallResult(Proc: TResElDataBuiltInProc;
{%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual; {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
procedure BI_Ord_OnEval(Proc: TResElDataBuiltInProc; procedure BI_Ord_OnEval(Proc: TResElDataBuiltInProc;
Params: TParamsExpr; out Evaluated: TResEvalValue); virtual; Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
function BI_LowHigh_OnGetCallCompatibility(Proc: TResElDataBuiltInProc; function BI_LowHigh_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
Expr: TPasExpr; RaiseOnError: boolean): integer; virtual; Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
procedure BI_LowHigh_OnGetCallResult(Proc: TResElDataBuiltInProc; procedure BI_LowHigh_OnGetCallResult(Proc: TResElDataBuiltInProc;
{%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual; {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
procedure BI_LowHigh_OnEval(Proc: TResElDataBuiltInProc; procedure BI_LowHigh_OnEval(Proc: TResElDataBuiltInProc;
Params: TParamsExpr; out Evaluated: TResEvalValue); virtual; Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
function BI_PredSucc_OnGetCallCompatibility(Proc: TResElDataBuiltInProc; function BI_PredSucc_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
Expr: TPasExpr; RaiseOnError: boolean): integer; virtual; Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
procedure BI_PredSucc_OnGetCallResult({%H-}Proc: TResElDataBuiltInProc; procedure BI_PredSucc_OnGetCallResult({%H-}Proc: TResElDataBuiltInProc;
{%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual; {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
procedure BI_PredSucc_OnEval(Proc: TResElDataBuiltInProc; procedure BI_PredSucc_OnEval(Proc: TResElDataBuiltInProc;
Params: TParamsExpr; out Evaluated: TResEvalValue); virtual; Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
function BI_Str_CheckParam(IsFunc: boolean; Param: TPasExpr; function BI_Str_CheckParam(IsFunc: boolean; Param: TPasExpr;
const ParamResolved: TPasResolverResult; ArgNo: integer; const ParamResolved: TPasResolverResult; ArgNo: integer;
RaiseOnError: boolean): integer; RaiseOnError: boolean): integer;
@ -1381,6 +1385,7 @@ type
property BaseTypeExtended: TResolverBaseType read FBaseTypeExtended write FBaseTypeExtended; property BaseTypeExtended: TResolverBaseType read FBaseTypeExtended write FBaseTypeExtended;
property BaseTypeString: TResolverBaseType read FBaseTypeString write FBaseTypeString; property BaseTypeString: TResolverBaseType read FBaseTypeString write FBaseTypeString;
property BaseTypeLength: TResolverBaseType read FBaseTypeLength write FBaseTypeLength; property BaseTypeLength: TResolverBaseType read FBaseTypeLength write FBaseTypeLength;
property ExprEvaluator: TResExprEvaluator read fExprEvaluator;
property DynArrayMinIndex: int64 read FDynArrayMinIndex write FDynArrayMinIndex; property DynArrayMinIndex: int64 read FDynArrayMinIndex write FDynArrayMinIndex;
property DynArrayMaxIndex: int64 read FDynArrayMaxIndex write FDynArrayMaxIndex; property DynArrayMaxIndex: int64 read FDynArrayMaxIndex write FDynArrayMaxIndex;
// parsed values // parsed values
@ -3444,7 +3449,9 @@ begin
if El.VarType<>nil then if El.VarType<>nil then
CheckAssignCompatibility(El,El.Expr,true) CheckAssignCompatibility(El,El.Expr,true)
else else
Eval(El.Expr,[refConst]); {$IFDEF EnablePasResRangeCheck}
Eval(El.Expr,[refConst])
{$ENDIF} ;
end; end;
procedure TPasResolver.FinishProcedure(aProc: TPasProcedure); procedure TPasResolver.FinishProcedure(aProc: TPasProcedure);
@ -4839,7 +4846,9 @@ begin
else else
RaiseMsg(20170216152125,nIllegalQualifier,sIllegalQualifier,[AssignKindNames[El.Kind]],El); RaiseMsg(20170216152125,nIllegalQualifier,sIllegalQualifier,[AssignKindNames[El.Kind]],El);
// store const expression result // store const expression result
{$IFDEF EnablePasResRangeCheck}
Eval(El.right,[]); Eval(El.right,[]);
{$ENDIF}
end; end;
else else
RaiseNotYetImplemented(20160927143649,El,'AssignKind '+AssignKindNames[El.Kind]); RaiseNotYetImplemented(20160927143649,El,'AssignKind '+AssignKindNames[El.Kind]);
@ -7084,7 +7093,7 @@ function TPasResolver.CheckIsOrdinal(
RaiseOnError: boolean): boolean; RaiseOnError: boolean): boolean;
begin begin
Result:=false; Result:=false;
if ResolvedEl.BaseType in (btAllInteger+btAllBooleans+[btChar]) then if ResolvedEl.BaseType in btAllRanges then
else if (ResolvedEl.BaseType=btContext) then else if (ResolvedEl.BaseType=btContext) then
begin begin
if ResolvedEl.TypeEl.ClassType=TPasEnumType then if ResolvedEl.TypeEl.ClassType=TPasEnumType then
@ -7332,6 +7341,8 @@ var
C: TClass; C: TClass;
BaseTypeData: TResElDataBaseType; BaseTypeData: TResElDataBaseType;
ResolvedType: TPasResolverResult; ResolvedType: TPasResolverResult;
EnumValue: TPasEnumValue;
EnumType: TPasEnumType;
begin begin
Result:=nil; Result:=nil;
if not (Expr.CustomData is TResolvedReference) then if not (Expr.CustomData is TResolvedReference) then
@ -7387,6 +7398,13 @@ begin
if refConst in Flags then if refConst in Flags then
RaiseConstantExprExp(20170518214928,Expr); RaiseConstantExprExp(20170518214928,Expr);
end end
else if C=TPasEnumValue then
begin
EnumValue:=TPasEnumValue(Decl);
EnumType:=EnumValue.Parent as TPasEnumType;
Result:=TResEvalEnum.CreateValue(EnumType.Values.IndexOf(EnumValue),EnumValue);
exit;
end
else if C.InheritsFrom(TPasType) then else if C.InheritsFrom(TPasType) then
begin begin
Decl:=ResolveAliasType(TPasType(Decl)); Decl:=ResolveAliasType(TPasType(Decl));
@ -7409,7 +7427,7 @@ begin
btChar: btChar:
begin begin
Result:=TResEvalRangeInt.Create; Result:=TResEvalRangeInt.Create;
TResEvalRangeInt(Result).ElKind:=revrikChar; TResEvalRangeInt(Result).ElKind:=revskChar;
TResEvalRangeInt(Result).RangeStart:=0; TResEvalRangeInt(Result).RangeStart:=0;
if BaseTypeChar=btChar then if BaseTypeChar=btChar then
TResEvalRangeInt(Result).RangeEnd:=$ff TResEvalRangeInt(Result).RangeEnd:=$ff
@ -7417,11 +7435,11 @@ begin
TResEvalRangeInt(Result).RangeEnd:=$ffff; TResEvalRangeInt(Result).RangeEnd:=$ffff;
end; end;
btAnsiChar: btAnsiChar:
Result:=TResEvalRangeInt.CreateValue(revrikChar,0,$ff); Result:=TResEvalRangeInt.CreateValue(revskChar,0,$ff);
btWideChar: btWideChar:
Result:=TResEvalRangeInt.CreateValue(revrikChar,0,$ffff); Result:=TResEvalRangeInt.CreateValue(revskChar,0,$ffff);
btBoolean,btByteBool,btWordBool,btQWordBool: btBoolean,btByteBool,btWordBool,btQWordBool:
Result:=TResEvalRangeInt.CreateValue(revrikBool,0,1); Result:=TResEvalRangeInt.CreateValue(revskBool,0,1);
btByte, btByte,
btShortInt, btShortInt,
btWord, btWord,
@ -7436,9 +7454,10 @@ begin
btUIntDouble: btUIntDouble:
begin begin
Result:=TResEvalRangeInt.Create; Result:=TResEvalRangeInt.Create;
TResEvalRangeInt(Result).ElKind:=revrikInt; TResEvalRangeInt(Result).ElKind:=revskInt;
GetIntegerRange(BaseTypeData.BaseType, GetIntegerRange(BaseTypeData.BaseType,
TResEvalRangeInt(Result).RangeStart,TResEvalRangeInt(Result).RangeEnd); TResEvalRangeInt(Result).RangeStart,TResEvalRangeInt(Result).RangeEnd);
exit;
end; end;
end; end;
end; end;
@ -7458,6 +7477,9 @@ var
bt: TResolverBaseType; bt: TResolverBaseType;
begin begin
Result:=nil; Result:=nil;
case Params.Kind of
pekArrayParams: ;
pekFuncParams:
if Params.Value.CustomData is TResolvedReference then if Params.Value.CustomData is TResolvedReference then
begin begin
Ref:=TResolvedReference(Params.Value.CustomData); Ref:=TResolvedReference(Params.Value.CustomData);
@ -7472,24 +7494,25 @@ begin
begin begin
BuiltInProc:=TResElDataBuiltInProc(Decl.CustomData); BuiltInProc:=TResElDataBuiltInProc(Decl.CustomData);
{$IFDEF VerbosePasResEval} {$IFDEF VerbosePasResEval}
writeln('TPasResolver.OnExprEvalParams BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn]); writeln('TPasResolver.OnExprEvalParams Calling BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
{$ENDIF} {$ENDIF}
case BuiltInProc.BuiltIn of case BuiltInProc.BuiltIn of
bfLength: BI_Length_OnEval(BuiltInProc,Params,Result); bfLength: BI_Length_OnEval(BuiltInProc,Params,Flags,Result);
bfOrd: BI_Ord_OnEval(BuiltInProc,Params,Result); bfChr: BI_Chr_OnEval(BuiltInProc,Params,Flags,Result);
bfLow,bfHigh: BI_LowHigh_OnEval(BuiltInProc,Params,Result); bfOrd: BI_Ord_OnEval(BuiltInProc,Params,Flags,Result);
bfPred,bfSucc: BI_PredSucc_OnEval(BuiltInProc,Params,Result); bfLow,bfHigh: BI_LowHigh_OnEval(BuiltInProc,Params,Flags,Result);
bfPred,bfSucc: BI_PredSucc_OnEval(BuiltInProc,Params,Flags,Result);
else else
{$IFDEF VerbosePasResEval} {$IFDEF VerbosePasResEval}
writeln('TPasResolver.OnExprEvalParams BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn]); writeln('TPasResolver.OnExprEvalParams Unhandled BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
{$ENDIF} {$ENDIF}
RaiseNotYetImplemented(20170624192324,Params); RaiseNotYetImplemented(20170624192324,Params);
end; end;
{$IFDEF VerbosePasResEval} {$IFDEF VerbosePasResEval}
if Result<>nil then if Result<>nil then
writeln('TPasResolver.OnExprEvalParams BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn],' Result=',Result.AsString) writeln('TPasResolver.OnExprEvalParams Called BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn],' Result=',Result.AsString)
else else
writeln('TPasResolver.OnExprEvalParams BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn],' Result=nil'); writeln('TPasResolver.OnExprEvalParams Called BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn],' Result=nil');
{$ENDIF} {$ENDIF}
exit; exit;
end end
@ -7502,8 +7525,15 @@ begin
{$IFDEF VerbosePasResEval} {$IFDEF VerbosePasResEval}
writeln('TPasResolver.OnExprEvalParams BuiltInProc ',Decl.Name,' ',GetObjName(Decl.CustomData)); writeln('TPasResolver.OnExprEvalParams BuiltInProc ',Decl.Name,' ',GetObjName(Decl.CustomData));
{$ENDIF} {$ENDIF}
end
else if C=TPasEnumType then
begin
// typecast to enumtype
Result:=fExprEvaluator.EnumTypeCast(TPasEnumType(Decl),Params.Params[0],Flags);
end; end;
end; end;
pekSet: ;
end;
if Flags=[] then ; if Flags=[] then ;
end; end;
@ -7767,22 +7797,18 @@ begin
end; end;
procedure TPasResolver.BI_Length_OnEval(Proc: TResElDataBuiltInProc; procedure TPasResolver.BI_Length_OnEval(Proc: TResElDataBuiltInProc;
Params: TParamsExpr; out Evaluated: TResEvalValue); Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
var var
Value: TResEvalValue; Value: TResEvalValue;
begin begin
Evaluated:=nil; Evaluated:=nil;
Value:=Eval(Params.Params[0],[refAutoConst]); Value:=Eval(Params.Params[0],Flags);
if Value=nil then exit; if Value=nil then exit;
if Value.Kind=revkString then case Value.Kind of
begin revkString:
Evaluated:=TResEvalInt.Create; Evaluated:=TResEvalInt.CreateValue(length(TResEvalString(Value).S));
TResEvalInt(Evaluated).Int:=length(TResEvalString(Value).S); revkUnicodeString:
end Evaluated:=TResEvalInt.CreateValue(length(TResEvalUTF16(Value).S));
else if Value.Kind=revkUnicodeString then
begin
Evaluated:=TResEvalInt.Create;
TResEvalInt(Evaluated).Int:=length(TResEvalUTF16(Value).S);
end; end;
ReleaseEvalValue(Value); ReleaseEvalValue(Value);
if Proc=nil then ; if Proc=nil then ;
@ -8134,6 +8160,30 @@ begin
SetResolverIdentifier(ResolvedEl,btChar,Proc.Proc,FBaseTypes[btChar],[rrfReadable]); SetResolverIdentifier(ResolvedEl,btChar,Proc.Proc,FBaseTypes[btChar],[rrfReadable]);
end; end;
procedure TPasResolver.BI_Chr_OnEval(Proc: TResElDataBuiltInProc;
Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
var
Param: TPasExpr;
Value: TResEvalValue;
begin
Evaluated:=nil;
Param:=Params.Params[0];
Value:=Eval(Param,Flags);
{$IFDEF VerbosePasResEval}
if Value=nil then
writeln('TPasResolver.BI_Chr_OnEval Value=NIL')
else
writeln('TPasResolver.BI_Chr_OnEval Value=',Value.AsDebugString);
{$ENDIF}
if Value=nil then exit;
try
Evaluated:=fExprEvaluator.ChrValue(Value,Params);
finally
ReleaseEvalValue(Value);
end;
if Proc=nil then ;
end;
function TPasResolver.BI_Ord_OnGetCallCompatibility(Proc: TResElDataBuiltInProc; function TPasResolver.BI_Ord_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
Expr: TPasExpr; RaiseOnError: boolean): integer; Expr: TPasExpr; RaiseOnError: boolean): integer;
var var
@ -8169,19 +8219,24 @@ begin
end; end;
procedure TPasResolver.BI_Ord_OnEval(Proc: TResElDataBuiltInProc; procedure TPasResolver.BI_Ord_OnEval(Proc: TResElDataBuiltInProc;
Params: TParamsExpr; out Evaluated: TResEvalValue); Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
var var
Param: TPasExpr; Param: TPasExpr;
Value: TResEvalValue; Value: TResEvalValue;
begin begin
Evaluated:=nil; Evaluated:=nil;
Param:=Params.Params[0]; Param:=Params.Params[0];
Value:=Eval(Param,[]); Value:=Eval(Param,Flags);
{$IFDEF VerbosePasResEval}
if Value=nil then
writeln('TPasResolver.BI_Ord_OnEval Value=NIL')
else
writeln('TPasResolver.BI_Ord_OnEval Value=',Value.AsDebugString);
{$ENDIF}
if Value=nil then exit; if Value=nil then exit;
try try
Evaluated:=fExprEvaluator.OrdValue(Value,Params); Evaluated:=fExprEvaluator.OrdValue(Value,Params);
finally finally
if Evaluated=nil then
ReleaseEvalValue(Value); ReleaseEvalValue(Value);
end; end;
if Proc=nil then ; if Proc=nil then ;
@ -8194,29 +8249,32 @@ var
Params: TParamsExpr; Params: TParamsExpr;
Param: TPasExpr; Param: TPasExpr;
ParamResolved: TPasResolverResult; ParamResolved: TPasResolverResult;
TypeEl: TPasType; C: TClass;
begin begin
if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
exit(cIncompatible); exit(cIncompatible);
Params:=TParamsExpr(Expr); Params:=TParamsExpr(Expr);
// first param: enum, range or char // first param: enumtype, range, built-in ordinal type (char, longint, ...)
Param:=Params.Params[0]; Param:=Params.Params[0];
ComputeElement(Param,ParamResolved,[]); ComputeElement(Param,ParamResolved,[]);
Result:=cIncompatible; Result:=cIncompatible;
if CheckIsOrdinal(ParamResolved,Param,false) then if not (rrfReadable in ParamResolved.Flags)
and (ParamResolved.BaseType in btAllRanges) then
// built-in range e.g. high(char)
Result:=cExact Result:=cExact
else if ParamResolved.BaseType=btSet then else if ParamResolved.BaseType=btSet then
Result:=cExact Result:=cExact
else if (ParamResolved.BaseType=btContext) then else if (ParamResolved.BaseType=btContext) then
begin begin
TypeEl:=ParamResolved.TypeEl; C:=ParamResolved.TypeEl.ClassType;
if (TypeEl.ClassType=TPasArrayType) if (C=TPasArrayType)
or (TypeEl.ClassType=TPasSetType) then or (C=TPasSetType)
or (C=TPasEnumType) then
Result:=cExact; Result:=cExact;
end; end;
if Result=cIncompatible then if Result=cIncompatible then
exit(CheckRaiseTypeArgNo(20170216152338,1,Param,ParamResolved,'enum or char',RaiseOnError)); exit(CheckRaiseTypeArgNo(20170216152338,1,Param,ParamResolved,'ordinal type, array or set',RaiseOnError));
Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError); Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
end; end;
@ -8263,28 +8321,23 @@ begin
end; end;
procedure TPasResolver.BI_LowHigh_OnEval(Proc: TResElDataBuiltInProc; procedure TPasResolver.BI_LowHigh_OnEval(Proc: TResElDataBuiltInProc;
Params: TParamsExpr; out Evaluated: TResEvalValue); Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
var var
Param: TPasExpr; Param: TPasExpr;
ResolvedEl: TPasResolverResult; ParamResolved: TPasResolverResult;
procedure EvalRange(RangeExpr: TPasExpr); procedure EvalRange(RangeExpr: TPasExpr);
var var
Range: TResEvalValue; Range: TResEvalValue;
EnumType: TPasEnumType; EnumType: TPasEnumType;
begin begin
Range:=Eval(RangeExpr,[refConst]); Range:=Eval(RangeExpr,Flags+[refConst]);
if Range=nil then if Range=nil then
RaiseNotYetImplemented(20170601191258,RangeExpr); RaiseNotYetImplemented(20170601191258,RangeExpr);
case Range.Kind of case Range.Kind of
revkRangeInt: revkRangeInt:
case TResEvalRangeInt(Range).ElKind of case TResEvalRangeInt(Range).ElKind of
revrikBool: revskEnum:
if Proc.BuiltIn=bfLow then
Evaluated:=TResEvalBool.CreateValue(low(Boolean))
else
Evaluated:=TResEvalBool.CreateValue(high(Boolean));
revrikEnum:
begin begin
EnumType:=TResEvalRangeInt(Range).IdentEl as TPasEnumType; EnumType:=TResEvalRangeInt(Range).IdentEl as TPasEnumType;
if Proc.BuiltIn=bfLow then if Proc.BuiltIn=bfLow then
@ -8295,18 +8348,23 @@ var
TResEvalRangeInt(Range).RangeEnd, TResEvalRangeInt(Range).RangeEnd,
TPasEnumValue(EnumType.Values[EnumType.Values.Count-1])); TPasEnumValue(EnumType.Values[EnumType.Values.Count-1]));
end; end;
revrikInt: revskInt:
if Proc.BuiltIn=bfLow then if Proc.BuiltIn=bfLow then
Evaluated:=TResEvalInt.CreateValue(TResEvalRangeInt(Range).RangeStart) Evaluated:=TResEvalInt.CreateValue(TResEvalRangeInt(Range).RangeStart)
else else
Evaluated:=TResEvalInt.CreateValue(TResEvalRangeInt(Range).RangeEnd); Evaluated:=TResEvalInt.CreateValue(TResEvalRangeInt(Range).RangeEnd);
revrikChar: revskChar:
if Proc.BuiltIn=bfLow then if Proc.BuiltIn=bfLow then
Evaluated:=TResEvalString.CreateValue(chr(TResEvalRangeInt(Range).RangeStart)) Evaluated:=TResEvalString.CreateValue(chr(TResEvalRangeInt(Range).RangeStart))
else if TResEvalRangeInt(Range).RangeEnd<256 then else if TResEvalRangeInt(Range).RangeEnd<256 then
Evaluated:=TResEvalString.CreateValue(chr(TResEvalRangeInt(Range).RangeEnd)) Evaluated:=TResEvalString.CreateValue(chr(TResEvalRangeInt(Range).RangeEnd))
else else
Evaluated:=TResEvalUTF16.CreateValue(widechar(TResEvalRangeInt(Range).RangeEnd)); Evaluated:=TResEvalUTF16.CreateValue(widechar(TResEvalRangeInt(Range).RangeEnd));
revskBool:
if Proc.BuiltIn=bfLow then
Evaluated:=TResEvalBool.CreateValue(low(Boolean))
else
Evaluated:=TResEvalBool.CreateValue(high(Boolean));
else else
RaiseNotYetImplemented(20170601195240,Param); RaiseNotYetImplemented(20170601195240,Param);
end; end;
@ -8329,27 +8387,26 @@ var
Int: MaxPrecInt; Int: MaxPrecInt;
bt: TResolverBaseType; bt: TResolverBaseType;
MinInt, MaxInt: int64; MinInt, MaxInt: int64;
i: Integer;
begin begin
Evaluated:=nil; Evaluated:=nil;
Param:=Params.Params[0]; Param:=Params.Params[0];
ComputeElement(Param,ResolvedEl,[]); ComputeElement(Param,ParamResolved,[]);
TypeEl:=ResolvedEl.TypeEl; TypeEl:=ParamResolved.TypeEl;
if ResolvedEl.BaseType=btContext then if ParamResolved.BaseType=btContext then
begin begin
if TypeEl.ClassType=TPasArrayType then if TypeEl.ClassType=TPasArrayType then
begin begin
// array: result is first dimension // array: low/high of first dimension
ArrayEl:=TPasArrayType(TypeEl); ArrayEl:=TPasArrayType(TypeEl);
if length(ArrayEl.Ranges)=0 then if length(ArrayEl.Ranges)=0 then
begin begin
// dyn or open array // dyn or open array
if Proc.BuiltIn=bfLow then if Proc.BuiltIn=bfLow then
Evaluated:=TResEvalInt.CreateValue(0) Evaluated:=TResEvalInt.CreateValue(0)
else if (ResolvedEl.IdentEl is TPasVariable) else if (ParamResolved.IdentEl is TPasVariable)
and (TPasVariable(ResolvedEl.IdentEl).Expr is TPasExpr) then and (TPasVariable(ParamResolved.IdentEl).Expr is TPasExpr) then
begin RaiseNotYetImplemented(20170601191003,Params)
RaiseNotYetImplemented(20170601191003,Params);
end
else else
exit; exit;
end end
@ -8361,6 +8418,7 @@ begin
end end
else if TypeEl.ClassType=TPasSetType then else if TypeEl.ClassType=TPasSetType then
begin begin
// set: first/last enum
TypeEl:=TPasSetType(TypeEl).EnumType; TypeEl:=TPasSetType(TypeEl).EnumType;
if TypeEl.ClassType=TPasEnumType then if TypeEl.ClassType=TPasEnumType then
begin begin
@ -8374,15 +8432,24 @@ begin
else else
begin begin
{$IFDEF VerbosePasResolver} {$IFDEF VerbosePasResolver}
writeln('TPasResolver.BI_LowHigh_OnEval ',GetResolverResultDbg(ResolvedEl),' TypeEl=',TypeEl.ClassName); writeln('TPasResolver.BI_LowHigh_OnEval ',GetResolverResultDbg(ParamResolved),' TypeEl=',TypeEl.ClassName);
{$ENDIF} {$ENDIF}
RaiseNotYetImplemented(20170601203026,Params); RaiseNotYetImplemented(20170601203026,Params);
end; end;
end
else if TypeEl.ClassType=TPasEnumType then
begin
EnumType:=TPasEnumType(TypeEl);
if Proc.BuiltIn=bfLow then
i:=0
else
i:=EnumType.Values.Count-1;
Evaluated:=TResEvalEnum.CreateValue(i,TPasEnumValue(EnumType.Values[i]))
end; end;
end end
else if ResolvedEl.BaseType=btSet then else if ParamResolved.BaseType=btSet then
begin begin
Value:=Eval(Param,[refAutoConst]); Value:=Eval(Param,Flags);
if Value=nil then exit; if Value=nil then exit;
case Value.Kind of case Value.Kind of
revkSetOfInt: revkSetOfInt:
@ -8395,20 +8462,23 @@ begin
else else
Int:=aSet.Ranges[length(aSet.Ranges)-1].RangeEnd; Int:=aSet.Ranges[length(aSet.Ranges)-1].RangeEnd;
case aSet.ElKind of case aSet.ElKind of
revsikEnum: revskEnum:
begin begin
EnumType:=aSet.IdentEl as TPasEnumType; EnumType:=aSet.IdentEl as TPasEnumType;
Evaluated:=TResEvalEnum.CreateValue(Int,TPasEnumValue(EnumType.Values[Int])); Evaluated:=TResEvalEnum.CreateValue(Int,TPasEnumValue(EnumType.Values[Int]));
end; end;
revsikInt: revskInt:
Evaluated:=TResEvalInt.CreateValue(Int); Evaluated:=TResEvalInt.CreateValue(Int);
revsikChar: revskChar:
if Int<256 then if Int<256 then
Evaluated:=TResEvalString.CreateValue(chr(Int)) Evaluated:=TResEvalString.CreateValue(chr(Int))
else else
Evaluated:=TResEvalUTF16.CreateValue(widechar(Int)); Evaluated:=TResEvalUTF16.CreateValue(widechar(Int));
revsikWChar: revskBool:
Evaluated:=TResEvalUTF16.CreateValue(widechar(Int)); if Int=0 then
Evaluated:=TResEvalBool.CreateValue(false)
else
Evaluated:=TResEvalBool.CreateValue(true)
end; end;
end; end;
else else
@ -8454,12 +8524,12 @@ begin
else else
begin begin
{$IFDEF VerbosePasResolver} {$IFDEF VerbosePasResolver}
writeln('TPasResolver.BI_LowHigh_OnEval ',GetResolverResultDbg(ResolvedEl)); writeln('TPasResolver.BI_LowHigh_OnEval ',GetResolverResultDbg(ParamResolved));
{$ENDIF} {$ENDIF}
RaiseNotYetImplemented(20170602070738,Params); RaiseNotYetImplemented(20170602070738,Params);
end; end;
end end
else if ResolvedEl.TypeEl is TPasRangeType then else if ParamResolved.TypeEl is TPasRangeType then
begin begin
// e.g. type t = 2..10; // e.g. type t = 2..10;
EvalRange(TPasRangeType(TypeEl).RangeExpr); EvalRange(TPasRangeType(TypeEl).RangeExpr);
@ -8467,15 +8537,15 @@ begin
else else
begin begin
{$IFDEF VerbosePasResolver} {$IFDEF VerbosePasResolver}
writeln('TPasResolver.BI_LowHigh_OnEval ',GetResolverResultDbg(ResolvedEl)); writeln('TPasResolver.BI_LowHigh_OnEval ',GetResolverResultDbg(ParamResolved));
{$ENDIF} {$ENDIF}
RaiseNotYetImplemented(20170601202353,Params); RaiseNotYetImplemented(20170601202353,Params);
end; end;
{$IFDEF VerbosePasResEval} {$IFDEF VerbosePasResEval}
if Evaluated=nil then if Evaluated=nil then
writeln('TPasResolver.BI_LowHigh_OnEval ResolvedEl=',GetResolverResultDbg(ResolvedEl),' Evaluated NO SET') writeln('TPasResolver.BI_LowHigh_OnEval END ResolvedEl=',GetResolverResultDbg(ParamResolved),' Evaluated NO SET')
else else
writeln('TPasResolver.BI_LowHigh_OnEval ResolvedEl=',GetResolverResultDbg(ResolvedEl),' Evaluated=',Evaluated.AsDebugString); writeln('TPasResolver.BI_LowHigh_OnEval END ResolvedEl=',GetResolverResultDbg(ParamResolved),' Evaluated=',Evaluated.AsDebugString);
{$ENDIF} {$ENDIF}
end; end;
@ -8511,14 +8581,14 @@ begin
end; end;
procedure TPasResolver.BI_PredSucc_OnEval(Proc: TResElDataBuiltInProc; procedure TPasResolver.BI_PredSucc_OnEval(Proc: TResElDataBuiltInProc;
Params: TParamsExpr; out Evaluated: TResEvalValue); Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
var var
Param: TPasExpr; Param: TPasExpr;
begin begin
//writeln('TPasResolver.BI_PredSucc_OnEval START'); //writeln('TPasResolver.BI_PredSucc_OnEval START');
Evaluated:=nil; Evaluated:=nil;
Param:=Params.Params[0]; Param:=Params.Params[0];
Evaluated:=Eval(Param,[]); Evaluated:=Eval(Param,Flags);
//writeln('TPasResolver.BI_PredSucc_OnEval Param=',Evaluated<>nil); //writeln('TPasResolver.BI_PredSucc_OnEval Param=',Evaluated<>nil);
if Evaluated=nil then exit; if Evaluated=nil then exit;
//writeln('TPasResolver.BI_PredSucc_OnEval Param=',Evaluated.AsString); //writeln('TPasResolver.BI_PredSucc_OnEval Param=',Evaluated.AsString);
@ -10425,9 +10495,11 @@ var
RangeResolved: TPasResolverResult; RangeResolved: TPasResolverResult;
bt: TResolverBaseType; bt: TResolverBaseType;
NextType: TPasType; NextType: TPasType;
ParamValue: TResEvalValue;
RangeExpr: TPasExpr; RangeExpr: TPasExpr;
TypeFits: Boolean; TypeFits: Boolean;
{$IFDEF EnablePasResRangeCheck}
ParamValue: TResEvalValue;
{$ENDIF}
begin begin
ArgNo:=0; ArgNo:=0;
repeat repeat
@ -10440,6 +10512,7 @@ begin
exit(CheckRaiseTypeArgNo(20170216152417,ArgNo,Param,ParamResolved,'integer',RaiseOnError)); exit(CheckRaiseTypeArgNo(20170216152417,ArgNo,Param,ParamResolved,'integer',RaiseOnError));
if EmitHints then if EmitHints then
begin begin
{$IFDEF EnablePasResRangeCheck}
ParamValue:=Eval(Param,[refAutoConst]); ParamValue:=Eval(Param,[refAutoConst]);
if ParamValue<>nil then if ParamValue<>nil then
try // has const value -> check range try // has const value -> check range
@ -10451,6 +10524,7 @@ begin
finally finally
ReleaseEvalValue(ParamValue); ReleaseEvalValue(ParamValue);
end; end;
{$ENDIF}
end; end;
end end
else else
@ -10490,8 +10564,10 @@ begin
RaiseIncompatibleTypeRes(20170216152422,nIncompatibleTypeArgNo, RaiseIncompatibleTypeRes(20170216152422,nIncompatibleTypeArgNo,
[IntToStr(ArgNo)],ParamResolved,RangeResolved,Param); [IntToStr(ArgNo)],ParamResolved,RangeResolved,Param);
end; end;
{$IFDEF EnablePasResRangeCheck}
if EmitHints then if EmitHints then
fExprEvaluator.IsInRange(Param,RangeExpr,true); fExprEvaluator.IsInRange(Param,RangeExpr,true);
{$ENDIF}
end; end;
end; end;
if ArgNo=length(Params.Params) then exit(cExact); if ArgNo=length(Params.Params) then exit(cExact);
@ -10751,6 +10827,9 @@ var
MinVal, MaxVal: int64; MinVal, MaxVal: int64;
RgExpr: TBinaryExpr; RgExpr: TBinaryExpr;
begin begin
{$IFNDEF EnablePasResRangeCheck}
exit;
{$ENDIF}
RValue:=Eval(RHS,[refAutoConst]); RValue:=Eval(RHS,[refAutoConst]);
if RValue=nil then if RValue=nil then
exit; // not a const expression exit; // not a const expression
@ -12696,7 +12775,7 @@ begin
else if (ElClass=TPasEnumValue) then else if (ElClass=TPasEnumValue) then
SetResolverIdentifier(ResolvedEl,btContext,El,El.Parent as TPasEnumType,[rrfReadable]) SetResolverIdentifier(ResolvedEl,btContext,El,El.Parent as TPasEnumType,[rrfReadable])
else if (ElClass=TPasEnumType) then else if (ElClass=TPasEnumType) then
SetResolverIdentifier(ResolvedEl,btContext,El,TPasEnumType(El),[rrfReadable]) SetResolverIdentifier(ResolvedEl,btContext,El,TPasEnumType(El),[])
else if (ElClass=TPasProperty) then else if (ElClass=TPasProperty) then
begin begin
if rcConstant in Flags then if rcConstant in Flags then

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

@ -191,6 +191,7 @@ type
Procedure TestBoolTypeCast; Procedure TestBoolTypeCast;
Procedure TestConstFloatOperators; Procedure TestConstFloatOperators;
Procedure TestFloatTypeCast; Procedure TestFloatTypeCast;
Procedure TestBoolSet_Const;
// integer range // integer range
Procedure TestIntegerRange; Procedure TestIntegerRange;
@ -199,6 +200,7 @@ type
Procedure TestAssignIntRangeFail; Procedure TestAssignIntRangeFail;
Procedure TestByteRangeFail; Procedure TestByteRangeFail;
Procedure TestCustomIntRangeFail; Procedure TestCustomIntRangeFail;
Procedure TestIntSet_Const;
// strings // strings
Procedure TestChar_Ord; Procedure TestChar_Ord;
@ -211,10 +213,12 @@ type
Procedure TestString_DoubleQuotesFail; Procedure TestString_DoubleQuotesFail;
Procedure TestString_ShortstringType; Procedure TestString_ShortstringType;
Procedure TestConstStringOperators; Procedure TestConstStringOperators;
Procedure TestConstUnicodeStringOperators;
Procedure TestCharSet_Const;
// enums // enums
Procedure TestEnums; Procedure TestEnums;
Procedure TestEnumRangeFail; // ToDo Procedure TestEnumRangeFail;
Procedure TestSets; Procedure TestSets;
Procedure TestSetOperators; Procedure TestSetOperators;
Procedure TestEnumParams; Procedure TestEnumParams;
@ -226,10 +230,11 @@ type
Procedure TestEnum_EqualNilFail; Procedure TestEnum_EqualNilFail;
Procedure TestEnum_CastIntegerToEnum; Procedure TestEnum_CastIntegerToEnum;
Procedure TestEnum_Str; Procedure TestEnum_Str;
Procedure TestSetConstRange; Procedure TestConstEnumOperators;
Procedure TestSet_AnonymousEnumtype; Procedure TestEnumSetConstRange;
Procedure TestSet_AnonymousEnumtypeName; Procedure TestEnumSet_AnonymousEnumtype;
Procedure TestSet_Const; // ToDo Procedure TestEnumSet_AnonymousEnumtypeName;
Procedure TestEnumSet_Const;
// operators // operators
Procedure TestPrgAssignment; Procedure TestPrgAssignment;
@ -547,7 +552,6 @@ type
// static arrays // static arrays
Procedure TestArrayIntRange_OutOfRange; Procedure TestArrayIntRange_OutOfRange;
Procedure TestArrayEnumRange_OutOfRange;
Procedure TestArrayCharRange_OutOfRange; Procedure TestArrayCharRange_OutOfRange;
// procedure types // procedure types
@ -2268,6 +2272,28 @@ begin
CheckResolverUnexpectedHints; CheckResolverUnexpectedHints;
end; end;
procedure TTestResolver.TestBoolSet_Const;
begin
StartProgram(false);
Add([
'const',
' s1 = [true];',
' s2 = [false,true];',
' s3 = [false..true];',
' s7 = [true]*s2;',
' s8 = s2-s1;',
' s9 = s1+s2;',
' s10 = s1><s2;',
' s11 = s2=s3;',
' s12 = s2<>s3;',
' s13 = s2<=s3;',
' s14 = s2>=s3;',
' s15 = true in s2;',
'begin']);
ParseProgram;
CheckResolverUnexpectedHints;
end;
procedure TTestResolver.TestIntegerRange; procedure TTestResolver.TestIntegerRange;
begin begin
StartProgram(false); StartProgram(false);
@ -2354,6 +2380,31 @@ begin
{$ENDIF} {$ENDIF}
end; end;
procedure TTestResolver.TestIntSet_Const;
begin
StartProgram(false);
Add([
'const',
' s1 = [1];',
' s2 = [1,2];',
' s3 = [1..3];',
' s4 = [1..2,4..5,6];',
' s5 = [low(shortint)..high(shortint)];',
' s6 = [succ(low(shortint))..pred(high(shortint))];',
' s7 = [1..3]*[2..4];',
' s8 = [1..5]-[2,5];',
' s9 = [1,3..4]+[2,5];',
' s10 = [1..3]><[2..5];',
' s11 = s2=s3;',
' s12 = s2<>s3;',
' s13 = s2<=s3;',
' s14 = s2>=s3;',
' s15 = 1 in s2;',
'begin']);
ParseProgram;
CheckResolverUnexpectedHints;
end;
procedure TTestResolver.TestChar_Ord; procedure TTestResolver.TestChar_Ord;
begin begin
StartProgram(false); StartProgram(false);
@ -2474,6 +2525,63 @@ begin
' h=a>=b;', ' h=a>=b;',
' i=a[1];', ' i=a[1];',
' j=length(a);', ' j=length(a);',
' k=chr(97);',
' l=ord(a[1]);',
' m=low(char)+high(char);',
'begin']);
ParseProgram;
CheckResolverUnexpectedHints;
end;
procedure TTestResolver.TestConstUnicodeStringOperators;
begin
ResolverEngine.ExprEvaluator.DefaultStringCodePage:=CP_UTF8;
StartProgram(false);
Add([
'const',
' a=''大''+''学'';',
' b=#22823+#23398;',
' c=a=b;',
' d=a<>b;',
' e=a<b;',
' f=a<=b;',
' g=a>b;',
' h=a>=b;',
' i=b[1];',
' j=length(b);',
' k=chr(22823);',
' l=ord(b[1]);',
' m=low(widechar)+high(widechar);',
' n=#65#22823;',
' ascii=#65;',
' o=ascii+b;',
'begin']);
ParseProgram;
CheckResolverUnexpectedHints;
end;
procedure TTestResolver.TestCharSet_Const;
begin
StartProgram(false);
Add([
'const',
' s1 = [''a''];',
' s2 = [''a'',''b''];',
' s3 = [''a''..''c''];',
' s4 = [''a''..''b'',''d''..''e'',''f''];',
' s5 = [low(Char)..high(Char)];',
' s6 = [succ(low(Char))..pred(high(Char))];',
' s7 = [''a''..''c'']*[''b''..''d''];',
' s8 = [''a''..''e'']-[''b'',''e''];',
' s9 = [''a'',''c''..''d'']+[''b'',''e''];',
' s10 = [''a''..''c'']><[''b''..''e''];',
' s11 = [''a'',''b'']=[''a''..''b''];',
' s12 = [''a'',''b'']<>[''a''..''b''];',
' s13 = [''a'',''b'']<=[''a''..''b''];',
' s14 = [''a'',''b'']>=[''a''..''b''];',
' s15 = ''a'' in [''a'',''b''];',
' s16 = [#0..#127,#22823..#23398];',
' s17 = #22823 in s16;',
'begin']); 'begin']);
ParseProgram; ParseProgram;
CheckResolverUnexpectedHints; CheckResolverUnexpectedHints;
@ -2503,14 +2611,12 @@ end;
procedure TTestResolver.TestEnumRangeFail; procedure TTestResolver.TestEnumRangeFail;
begin begin
exit; // ToDo
StartProgram(false); StartProgram(false);
Add([ Add([
'type TFlag = (a,b,c);', 'type TFlag = (a,b,c);',
'const all = a..c;', 'const all = a..c;',
'begin']); 'begin']);
CheckParserException('aaa',123); CheckParserException('Const ranges are not allowed',nParserNoConstRangeAllowed);
end; end;
procedure TTestResolver.TestSets; procedure TTestResolver.TestSets;
@ -2766,7 +2872,24 @@ begin
ParseProgram; ParseProgram;
end; end;
procedure TTestResolver.TestSetConstRange; procedure TTestResolver.TestConstEnumOperators;
begin
StartProgram(false);
Add([
'type',
' TEnum = (red,blue,green);',
'const',
' a=ord(red);',
' b=succ(low(TEnum));',
' c=pred(high(TEnum));',
' d=TEnum(0);',
' e=TEnum(2);',
'begin']);
ParseProgram;
CheckResolverUnexpectedHints;
end;
procedure TTestResolver.TestEnumSetConstRange;
begin begin
StartProgram(false); StartProgram(false);
Add([ Add([
@ -2793,7 +2916,7 @@ begin
CheckResolverUnexpectedHints; CheckResolverUnexpectedHints;
end; end;
procedure TTestResolver.TestSet_AnonymousEnumtype; procedure TTestResolver.TestEnumSet_AnonymousEnumtype;
begin begin
StartProgram(false); StartProgram(false);
Add('type'); Add('type');
@ -2818,7 +2941,7 @@ begin
ParseProgram; ParseProgram;
end; end;
procedure TTestResolver.TestSet_AnonymousEnumtypeName; procedure TTestResolver.TestEnumSet_AnonymousEnumtypeName;
begin begin
ResolverEngine.AnonymousElTypePostfix:='$enum'; ResolverEngine.AnonymousElTypePostfix:='$enum';
StartProgram(false); StartProgram(false);
@ -2844,17 +2967,28 @@ begin
ParseProgram; ParseProgram;
end; end;
procedure TTestResolver.TestSet_Const; procedure TTestResolver.TestEnumSet_Const;
begin begin
StartProgram(false); StartProgram(false);
Add([ Add([
'type', 'type',
' TFlag = (a,b,c,d,e,f);', ' TFlag = (a,b,c,d,e,f);',
'const', 'const',
' ab = [a..b];', ' s1 = [a];',
//' notc = [a..b,d..e,f];', ' s2 = [a,b];',
//' all = [low(TFlag)..high(TFlag)];', ' s3 = [a..c];',
//' notaf = [succ(low(TFlag))..pred(high(TFlag))];', ' s4 = [a..b,d..e,f];',
' s5 = [low(TFlag)..high(TFlag)];',
' s6 = [succ(low(TFlag))..pred(high(TFlag))];',
' s7 = [a..c]*[b..d];',
' s8 = [a..e]-[b,e];',
' s9 = [a,c..d]+[b,e];',
' s10 = [a..c]><[b..e];',
' s11 = [a,b]=[a..b];',
' s12 = [a,b]<>[a..b];',
' s13 = [a,b]<=[a..b];',
' s14 = [a,b]>=[a..b];',
' s15 = a in [a,b];',
'begin']); 'begin']);
ParseProgram; ParseProgram;
CheckResolverUnexpectedHints; CheckResolverUnexpectedHints;
@ -8741,23 +8875,10 @@ begin
' a[0]:=3;', ' a[0]:=3;',
'']); '']);
ParseProgram; ParseProgram;
{$IFDEF EnablePasResRangeCheck}
CheckResolverHint(mtWarning,nRangeCheckEvaluatingConstantsVMinMax, CheckResolverHint(mtWarning,nRangeCheckEvaluatingConstantsVMinMax,
'range check error while evaluating constants (0 must be between 1 and 2)'); 'range check error while evaluating constants (0 must be between 1 and 2)');
CheckResolverUnexpectedHints; {$ENDIF}
end;
procedure TTestResolver.TestArrayEnumRange_OutOfRange;
begin
StartProgram(false);
Add([
'type',
' TEnum = (red,blue);',
' TArr = array[TEnum] of longint;',
'var a: TArr;',
'begin',
' a[red]:=3;',
'']);
ParseProgram;
CheckResolverUnexpectedHints; CheckResolverUnexpectedHints;
end; end;
@ -8771,8 +8892,10 @@ begin
' a[''0'']:=3;', ' a[''0'']:=3;',
'']); '']);
ParseProgram; ParseProgram;
{$IFDEF EnablePasResRangeCheck}
CheckResolverHint(mtWarning,nRangeCheckEvaluatingConstantsVMinMax, CheckResolverHint(mtWarning,nRangeCheckEvaluatingConstantsVMinMax,
'range check error while evaluating constants (''0'' must be between ''a'' and ''b'')'); 'range check error while evaluating constants (''0'' must be between ''a'' and ''b'')');
{$ENDIF}
CheckResolverUnexpectedHints; CheckResolverUnexpectedHints;
end; end;

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

@ -2691,6 +2691,7 @@ var
bt: TPas2jsBaseType; bt: TPas2jsBaseType;
begin begin
inherited; inherited;
ExprEvaluator.DefaultStringCodePage:=CP_UTF8;
FExternalNames:=TFPHashList.Create; FExternalNames:=TFPHashList.Create;
StoreSrcColumns:=true; StoreSrcColumns:=true;
Options:=Options+DefaultPasResolverOptions; Options:=Options+DefaultPasResolverOptions;