From 849d604c044f25e181898317d5a897070313d841 Mon Sep 17 00:00:00 2001 From: mattias Date: Thu, 6 Jun 2019 09:51:37 +0000 Subject: [PATCH] fcl-pssrc, pastojs: fixed anonymous proc inside for-loop --- .../packages/fcl-passrc/src/pasresolver.pp | 443 +++++++++--------- compiler/packages/fcl-passrc/src/pparser.pp | 4 +- .../packages/fcl-passrc/tests/tcresolver.pas | 22 + compiler/packages/pastojs/src/fppas2js.pp | 2 +- compiler/packages/pastojs/tests/tcmodules.pas | 39 ++ 5 files changed, 287 insertions(+), 223 deletions(-) diff --git a/compiler/packages/fcl-passrc/src/pasresolver.pp b/compiler/packages/fcl-passrc/src/pasresolver.pp index 7289977..965a030 100644 --- a/compiler/packages/fcl-passrc/src/pasresolver.pp +++ b/compiler/packages/fcl-passrc/src/pasresolver.pp @@ -1467,7 +1467,6 @@ type procedure ResolveImplElement(El: TPasImplElement); virtual; procedure ResolveImplCaseOf(CaseOf: TPasImplCaseOf); virtual; procedure ResolveImplLabelMark(Mark: TPasImplLabelMark); virtual; - procedure ResolveImplForLoop(Loop: TPasImplForLoop); virtual; procedure ResolveImplWithDo(El: TPasImplWithDo); virtual; procedure ResolveImplAsm(El: TPasImplAsmStatement); virtual; procedure ResolveImplAssign(El: TPasImplAssign); virtual; @@ -1525,6 +1524,7 @@ type procedure FinishExceptOnExpr; virtual; procedure FinishExceptOnStatement; virtual; procedure FinishWithDo(El: TPasImplWithDo); virtual; + procedure FinishForLoopHeader(Loop: TPasImplForLoop); virtual; procedure FinishDeclaration(El: TPasElement); virtual; procedure FinishVariable(El: TPasVariable); virtual; procedure FinishProperty(PropEl: TPasProperty); virtual; @@ -6390,6 +6390,224 @@ begin PopWithScope(El); end; +procedure TPasResolver.FinishForLoopHeader(Loop: TPasImplForLoop); +var + VarResolved, StartResolved, EndResolved, + OrigStartResolved: TPasResolverResult; + EnumeratorFound, HasInValues: Boolean; + InRange, VarRange: TResEvalValue; + InRangeInt, VarRangeInt: TResEvalRangeInt; + bt: TResolverBaseType; + TypeEl, ElType: TPasType; + C: TClass; +begin + CreateScope(Loop,TPasForLoopScope); + + // loop var + ResolveExpr(Loop.VariableName,rraReadAndAssign); + ComputeElement(Loop.VariableName,VarResolved,[rcNoImplicitProc,rcSetReferenceFlags]); + if not ResolvedElCanBeVarParam(VarResolved,Loop.VariableName) then + RaiseVarExpected(20170216151955,Loop.VariableName,VarResolved.IdentEl); + + // resolve start expression + ResolveExpr(Loop.StartExpr,rraRead); + ComputeElement(Loop.StartExpr,StartResolved,[rcSetReferenceFlags]); + + case Loop.LoopType of + ltNormal,ltDown: + begin + // start value + if CheckAssignResCompatibility(VarResolved,StartResolved,Loop.StartExpr,true)=cIncompatible then + RaiseIncompatibleTypeRes(20170216151958,nIncompatibleTypesGotExpected, + [],StartResolved,VarResolved,Loop.StartExpr); + CheckAssignExprRange(VarResolved,Loop.StartExpr); + + // end value + ResolveExpr(Loop.EndExpr,rraRead); + ComputeElement(Loop.EndExpr,EndResolved,[rcSetReferenceFlags]); + if CheckAssignResCompatibility(VarResolved,EndResolved,Loop.EndExpr,false)=cIncompatible then + RaiseIncompatibleTypeRes(20170216152001,nIncompatibleTypesGotExpected, + [],EndResolved,VarResolved,Loop.EndExpr); + CheckAssignExprRange(VarResolved,Loop.EndExpr); + end; + ltIn: + begin + // check range + EnumeratorFound:=CheckForIn(Loop,VarResolved,StartResolved); + if (not EnumeratorFound) + and not (StartResolved.IdentEl is TPasType) + and (rrfReadable in StartResolved.Flags) then + begin + EnumeratorFound:=CheckForInClassOrRec(Loop,VarResolved,StartResolved); + end; + + if not EnumeratorFound then + begin + VarRange:=nil; + InRange:=nil; + try + OrigStartResolved:=StartResolved; + if StartResolved.IdentEl is TPasType then + begin + // e.g. for e in TEnum do + TypeEl:=StartResolved.LoTypeEl; + if TypeEl is TPasArrayType then + begin + if length(TPasArrayType(TypeEl).Ranges)=1 then + InRange:=Eval(TPasArrayType(TypeEl).Ranges[0],[refConst]); + end; + if InRange=nil then + InRange:=EvalTypeRange(TypeEl,[]); + {$IFDEF VerbosePasResolver} + {AllowWriteln} + if InRange<>nil then + writeln('TPasResolver.ResolveImplForLoop in type: InRange=',InRange.AsDebugString) + else + writeln('TPasResolver.ResolveImplForLoop in type: InRange=nil'); + {AllowWriteln-} + {$ENDIF} + end + else if rrfReadable in StartResolved.Flags then + begin + // value (variable or expression) + bt:=StartResolved.BaseType; + if bt in [btSet,btArrayOrSet] then + begin + if (StartResolved.IdentEl=nil) and (StartResolved.ExprEl<>nil) then + InRange:=Eval(StartResolved.ExprEl,[]); + if InRange=nil then + InRange:=EvalTypeRange(StartResolved.LoTypeEl,[]); + end + else if bt=btContext then + begin + TypeEl:=StartResolved.LoTypeEl; + C:=TypeEl.ClassType; + if C=TPasArrayType then + begin + ElType:=GetArrayElType(TPasArrayType(TypeEl)); + ComputeElement(ElType,StartResolved,[rcType]); + StartResolved.Flags:=OrigStartResolved.Flags*[rrfReadable,rrfWritable]; + if CheckAssignResCompatibility(VarResolved,StartResolved,Loop.StartExpr,true)=cIncompatible then + RaiseIncompatibleTypeRes(20171112210138,nIncompatibleTypesGotExpected, + [],StartResolved,VarResolved,Loop.StartExpr); + EnumeratorFound:=true; + end; + end + else + begin + bt:=GetActualBaseType(bt); + case bt of + {$ifdef FPC_HAS_CPSTRING} + btAnsiString: + InRange:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ff); + {$endif} + btUnicodeString: + InRange:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ffff); + end; + end; + end; + if (not EnumeratorFound) and (InRange<>nil) then + begin + // for v in do + // -> check if same type + VarRange:=EvalTypeRange(VarResolved.LoTypeEl,[]); + if VarRange=nil then + RaiseXExpectedButYFound(20171109191528,'range', + GetResolverResultDescription(VarResolved),Loop.VariableName); + //writeln('TPasResolver.ResolveImplForLoop ForIn VarRange=',VarRange.AsDebugString); + //writeln('TPasResolver.ResolveImplForLoop ForIn InRange=',InRange.AsDebugString,' ElType=',GetResolverResultDbg(StartResolved)); + case InRange.Kind of + revkRangeInt,revkSetOfInt: + begin + InRangeInt:=TResEvalRangeInt(InRange); + case VarRange.Kind of + revkRangeInt: + begin + VarRangeInt:=TResEvalRangeInt(VarRange); + HasInValues:=(InRange.Kind<>revkSetOfInt) or (length(TResEvalSet(InRange).Ranges)>0); + case InRangeInt.ElKind of + revskEnum: + if (VarRangeInt.ElKind<>revskEnum) + or not IsSameType(InRangeInt.ElType,VarRangeInt.ElType,prraAlias) then + RaiseXExpectedButYFound(20171109200752,GetTypeDescription(InRangeInt.ElType), + GetResolverResultDescription(VarResolved,true),loop.VariableName); + revskInt: + if VarRangeInt.ElKind<>revskInt then + RaiseXExpectedButYFound(20171109200752,'integer', + GetResolverResultDescription(VarResolved,true),loop.VariableName); + revskChar: + if VarRangeInt.ElKind<>revskChar then + RaiseXExpectedButYFound(20171109200753,'char', + GetResolverResultDescription(VarResolved,true),loop.VariableName); + revskBool: + if VarRangeInt.ElKind<>revskBool then + RaiseXExpectedButYFound(20171109200754,'boolean', + GetResolverResultDescription(VarResolved,true),loop.VariableName); + else + if HasInValues then + RaiseNotYetImplemented(20171109200954,Loop.StartExpr); + end; + if HasInValues then + begin + if (VarRangeInt.RangeStart>InRangeInt.RangeStart) then + begin + {$IFDEF VerbosePasResolver} + writeln('TPasResolver.ResolveImplForLoop VarRange=',VarRangeInt.AsDebugString,' ',InRangeInt.AsDebugString); + {$ENDIF} + fExprEvaluator.EmitRangeCheckConst(20171109201428, + InRangeInt.ElementAsString(InRangeInt.RangeStart), + VarRangeInt.ElementAsString(VarRangeInt.RangeStart), + VarRangeInt.ElementAsString(VarRangeInt.RangeEnd),Loop.VariableName,mtError); + end; + if (VarRangeInt.RangeEndnil) then - InRange:=Eval(StartResolved.ExprEl,[]); - if InRange=nil then - InRange:=EvalTypeRange(StartResolved.LoTypeEl,[]); - end - else if bt=btContext then - begin - TypeEl:=StartResolved.LoTypeEl; - C:=TypeEl.ClassType; - if C=TPasArrayType then - begin - ElType:=GetArrayElType(TPasArrayType(TypeEl)); - ComputeElement(ElType,StartResolved,[rcType]); - StartResolved.Flags:=OrigStartResolved.Flags*[rrfReadable,rrfWritable]; - if CheckAssignResCompatibility(VarResolved,StartResolved,Loop.StartExpr,true)=cIncompatible then - RaiseIncompatibleTypeRes(20171112210138,nIncompatibleTypesGotExpected, - [],StartResolved,VarResolved,Loop.StartExpr); - EnumeratorFound:=true; - end; - end - else - begin - bt:=GetActualBaseType(bt); - case bt of - {$ifdef FPC_HAS_CPSTRING} - btAnsiString: - InRange:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ff); - {$endif} - btUnicodeString: - InRange:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ffff); - end; - end; - end; - if (not EnumeratorFound) and (InRange<>nil) then - begin - // for v in do - // -> check if same type - VarRange:=EvalTypeRange(VarResolved.LoTypeEl,[]); - if VarRange=nil then - RaiseXExpectedButYFound(20171109191528,'range', - GetResolverResultDescription(VarResolved),Loop.VariableName); - //writeln('TPasResolver.ResolveImplForLoop ForIn VarRange=',VarRange.AsDebugString); - //writeln('TPasResolver.ResolveImplForLoop ForIn InRange=',InRange.AsDebugString,' ElType=',GetResolverResultDbg(StartResolved)); - case InRange.Kind of - revkRangeInt,revkSetOfInt: - begin - InRangeInt:=TResEvalRangeInt(InRange); - case VarRange.Kind of - revkRangeInt: - begin - VarRangeInt:=TResEvalRangeInt(VarRange); - HasInValues:=(InRange.Kind<>revkSetOfInt) or (length(TResEvalSet(InRange).Ranges)>0); - case InRangeInt.ElKind of - revskEnum: - if (VarRangeInt.ElKind<>revskEnum) - or not IsSameType(InRangeInt.ElType,VarRangeInt.ElType,prraAlias) then - RaiseXExpectedButYFound(20171109200752,GetTypeDescription(InRangeInt.ElType), - GetResolverResultDescription(VarResolved,true),loop.VariableName); - revskInt: - if VarRangeInt.ElKind<>revskInt then - RaiseXExpectedButYFound(20171109200752,'integer', - GetResolverResultDescription(VarResolved,true),loop.VariableName); - revskChar: - if VarRangeInt.ElKind<>revskChar then - RaiseXExpectedButYFound(20171109200753,'char', - GetResolverResultDescription(VarResolved,true),loop.VariableName); - revskBool: - if VarRangeInt.ElKind<>revskBool then - RaiseXExpectedButYFound(20171109200754,'boolean', - GetResolverResultDescription(VarResolved,true),loop.VariableName); - else - if HasInValues then - RaiseNotYetImplemented(20171109200954,Loop.StartExpr); - end; - if HasInValues then - begin - if (VarRangeInt.RangeStart>InRangeInt.RangeStart) then - begin - {$IFDEF VerbosePasResolver} - writeln('TPasResolver.ResolveImplForLoop VarRange=',VarRangeInt.AsDebugString,' ',InRangeInt.AsDebugString); - {$ENDIF} - fExprEvaluator.EmitRangeCheckConst(20171109201428, - InRangeInt.ElementAsString(InRangeInt.RangeStart), - VarRangeInt.ElementAsString(VarRangeInt.RangeStart), - VarRangeInt.ElementAsString(VarRangeInt.RangeEnd),Loop.VariableName,mtError); - end; - if (VarRangeInt.RangeEnd