From 429f5346fc3090015aab1ae0888864f72c18c250 Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Mon, 13 Nov 2017 13:36:33 +0000 Subject: [PATCH] fcl-passrc: resolver: for in array do git-svn-id: trunk@37588 - --- packages/fcl-passrc/src/pasresolver.pp | 69 ++++++++++++++++----- packages/fcl-passrc/src/pasuseanalyzer.pas | 2 +- packages/fcl-passrc/tests/tcresolver.pas | 15 +++++ packages/fcl-passrc/tests/tcuseanalyzer.pas | 14 +++++ 4 files changed, 83 insertions(+), 17 deletions(-) diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index 3587174df2..7653c56ee0 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -159,15 +159,16 @@ Works: rg:=rg, rg1:=rg2, rg:=enum, =, <>, in array[rg], low(array), high(array) - for..in..do : - - boolean, char, byte, shortint, word, smallint, longword, longint - - enum range, char range, integer range - - set of enum, enum range, integer, integer range, char, char range + - type boolean, char, byte, shortint, word, smallint, longword, longint + - type enum range, char range, integer range + - type/var set of: enum, enum range, integer, integer range, char, char range + - array var ToDo: - for..in..do - - array - - operator + - function: enumerator - class + - operator - range checking: - indexedprop[param] - case-of unique @@ -4956,15 +4957,14 @@ var EnumeratorFound: Boolean; InRange, VarRange: TResEvalValue; InRangeInt, VarRangeInt: TResEvalRangeInt; + bt: TResolverBaseType; + TypeEl: TPasType; + C: TClass; begin // loop var ResolveExpr(Loop.VariableName,rraReadAndAssign); ComputeElement(Loop.VariableName,VarResolved,[rcNoImplicitProc,rcSetReferenceFlags]); - if ResolvedElCanBeVarParam(VarResolved) - and ((VarResolved.BaseType in (btAllBooleans+btAllInteger+btAllChars)) - or ((VarResolved.BaseType=btContext) and (VarResolved.TypeEl.ClassType=TPasEnumType))) - or (VarResolved.BaseType=btRange) then - else + if not ResolvedElCanBeVarParam(VarResolved) then RaiseMsg(20170216151955,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Loop.VariableName); // resolve start expression @@ -5000,11 +5000,43 @@ begin InRange:=nil; try OrigStartResolved:=StartResolved; - InRange:=EvalTypeRange(StartResolved.TypeEl,[]); - if InRange<>nil then + if StartResolved.IdentEl is TPasType then + // e.g. for e in TEnum do + InRange:=EvalTypeRange(StartResolved.TypeEl,[]) + else if rrfReadable in StartResolved.Flags then begin + // value (variable or expression) + bt:=StartResolved.BaseType; + if bt=btSet then + InRange:=EvalTypeRange(StartResolved.TypeEl,[]) + else if bt=btContext then + begin + TypeEl:=ResolveAliasType(StartResolved.TypeEl); + C:=TypeEl.ClassType; + if C=TPasArrayType then + begin + ComputeElement(TPasArrayType(TypeEl).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); + if bt=btAnsiString then + InRange:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ff) + else if bt=btUnicodeString then + InRange:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ffff); + end; + end; + if (not EnumeratorFound) and (InRange<>nil) then + begin + // in parameter is a constant + // -> check if same type //writeln('TPasResolver.ResolveImplForLoop ForIn InRange=',InRange.AsDebugString,' ElType=',GetResolverResultDbg(StartResolved)); - // check if same type case InRange.Kind of revkRangeInt: begin @@ -5058,14 +5090,19 @@ begin {$ENDIF} end; end; + if not EnumeratorFound then + begin + {$IFDEF VerbosePasResolver} + writeln('TPasResolver.ResolveImplForLoop VarRange=',VarRange.AsDebugString,' StartResolved=',GetResolverResultDbg(StartResolved)); + {$ENDIF} + RaiseMsg(20171108223818,nCannotFindEnumeratorForType,sCannotFindEnumeratorForType, + [GetBaseDescription(OrigStartResolved)],Loop.StartExpr); + end; finally ReleaseEvalValue(VarRange); ReleaseEvalValue(InRange); end; - if not EnumeratorFound then - RaiseMsg(20171108223818,nCannotFindEnumeratorForType,sCannotFindEnumeratorForType, - [GetBaseDescription(OrigStartResolved)],Loop.StartExpr); end; else RaiseNotYetImplemented(20171108221334,Loop); diff --git a/packages/fcl-passrc/src/pasuseanalyzer.pas b/packages/fcl-passrc/src/pasuseanalyzer.pas index 6e238f3f8b..8b22f9c802 100644 --- a/packages/fcl-passrc/src/pasuseanalyzer.pas +++ b/packages/fcl-passrc/src/pasuseanalyzer.pas @@ -1817,7 +1817,7 @@ begin else begin // parameter was used - if (Usage.Access=paiaWrite) and (Arg.Access<>argOut) then + if (Usage.Access=paiaWrite) and not (Arg.Access in [argOut,argVar]) then EmitMessage(20170312095348,mtHint,nPAValueParameterIsAssignedButNeverUsed, sPAValueParameterIsAssignedButNeverUsed,[Arg.Name],Arg); end; diff --git a/packages/fcl-passrc/tests/tcresolver.pas b/packages/fcl-passrc/tests/tcresolver.pas index a12fb74f80..127c8aed30 100644 --- a/packages/fcl-passrc/tests/tcresolver.pas +++ b/packages/fcl-passrc/tests/tcresolver.pas @@ -2786,16 +2786,31 @@ begin ' TCharRg = ''a''..''z'';', ' TSetOfChar = set of char;', ' TSetOfCharRg = set of TCharRg;', + 'const Foo = ''foo'';', 'var', ' c: char;', ' cr: TCharRg;', + ' s: string;', + ' a: array of char;', + ' b: array[1..3] of char;', + ' soc: TSetOfChar;', + ' socr: TSetOfCharRg;', 'begin', + ' for c in foo do;', + ' for c in s do;', + ' for c in a do;', + ' for c in b do;', ' for c in char do;', ' for c in TCharRg do;', ' for c in TSetOfChar do;', ' for c in TSetOfCharRg do;', + ' for c in soc do;', + ' for c in socr do;', + ' for c in [''A''..''C''] do ;', ' for cr in TCharRg do;', ' for cr in TSetOfCharRg do;', + ' for cr in socr do;', + //' for cr in [''b''..''d''] do ;', '']); ParseProgram; end; diff --git a/packages/fcl-passrc/tests/tcuseanalyzer.pas b/packages/fcl-passrc/tests/tcuseanalyzer.pas index 56fa4e816e..e314ae96bb 100644 --- a/packages/fcl-passrc/tests/tcuseanalyzer.pas +++ b/packages/fcl-passrc/tests/tcuseanalyzer.pas @@ -80,6 +80,7 @@ type procedure TestM_Hint_UnitNotUsed; procedure TestM_Hint_UnitNotUsed_No_OnlyExternal; procedure TestM_Hint_ParameterNotUsed; + procedure TestM_Hint_ParameterAssignedButNotReadVarParam; procedure TestM_Hint_ParameterNotUsed_Abstract; procedure TestM_Hint_ParameterNotUsedTypecast; procedure TestM_Hint_OutParam_No_AssignedButNeverUsed; @@ -967,6 +968,19 @@ begin CheckUseAnalyzerUnexpectedHints; end; +procedure TTestUseAnalyzer.TestM_Hint_ParameterAssignedButNotReadVarParam; +begin + StartProgram(true); + Add([ + 'procedure DoIt(var i: longint);', + 'begin i:=3; end;', + 'var v: longint;', + 'begin', + ' DoIt(v);']); + AnalyzeProgram; + CheckUseAnalyzerUnexpectedHints; +end; + procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsed_Abstract; begin StartProgram(true);