From ef82aff9cdb8d52144ba32a4308d2c301934d6ea Mon Sep 17 00:00:00 2001 From: michael Date: Fri, 17 Mar 2017 21:25:35 +0000 Subject: [PATCH] * Patch from Mattias Gaertner: - nicer error handling for resourcestrings - resolve 'Result' element always to declaration git-svn-id: trunk@35613 - --- packages/fcl-passrc/src/pasresolver.pp | 31 ++++++--- packages/fcl-passrc/src/pparser.pp | 4 +- packages/fcl-passrc/src/pscanner.pp | 29 +++++++-- packages/fcl-passrc/tests/tcresolver.pas | 83 +++++++++++++++++++++++- 4 files changed, 129 insertions(+), 18 deletions(-) diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index 2286293b8e..c2d32db009 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -113,6 +113,7 @@ Works: ToDo: +- fix slow lookup declaration proc in PParser - fail to write a loop var inside the loop - warn: create class with abstract methods - classes - TPasClassType @@ -466,7 +467,9 @@ type procedure SetPasElement(AValue: TPasElement); public Id: int64; + MsgType: TMessageType; MsgNumber: integer; + MsgPattern: String; Args: TMessageArgs; destructor Destroy; override; property PasElement: TPasElement read FPasElement write SetPasElement; @@ -1141,7 +1144,7 @@ type Const Fmt : String; Args : Array of const; Element: TPasElement); procedure LogMsg(const id: int64; MsgType: TMessageType; MsgNumber: integer; const Fmt: String; Args: Array of const; PosEl: TPasElement); overload; - procedure RaiseMsg(const id: int64; MsgNumber: integer; const Fmt: String; + procedure RaiseMsg(const Id: int64; MsgNumber: integer; const Fmt: String; Args: Array of const; ErrorPosEl: TPasElement); procedure RaiseNotYetImplemented(id: int64; El: TPasElement; Msg: string = ''); virtual; procedure RaiseInternalError(id: int64; const Msg: string = ''); @@ -3786,6 +3789,13 @@ begin else RaiseNotYetImplemented(20170203161826,ImplProc); end; + if DeclProc is TPasFunction then + begin + // replace 'Result' + Identifier:=ImplProcScope.FindLocalIdentifier(ResolverResultVar); + if Identifier.Element is TPasResultElement then + Identifier.Element:=TPasFunction(DeclProc).FuncType.ResultEl; + end; end; procedure TPasResolver.CheckProcSignatureMatch(DeclProc, ImplProc: TPasProcedure @@ -5147,6 +5157,7 @@ begin {$ENDIF} if not (TopScope is TPasIdentifierScope) then RaiseInvalidScopeForElement(20160922163522,El); + // Note: El.ProcType is nil ! AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikProc); ProcScope:=TPasProcedureScope(PushScope(El,TPasProcedureScope)); ProcName:=El.Name; @@ -5181,7 +5192,7 @@ begin else NeedPop:=false; - CurClassType:=TPasClassType(FindElementWithoutParams(aClassName,El.ProcType,false)); + CurClassType:=TPasClassType(FindElementWithoutParams(aClassName,El,false)); if not (CurClassType is TPasClassType) then begin aClassName:=LeftStr(El.Name,length(El.Name)-length(ProcName)); @@ -5245,8 +5256,8 @@ end; procedure TPasResolver.AddFunctionResult(El: TPasResultElement); begin - if TopScope.ClassType=TPasProcedureScope then - AddIdentifier(TPasProcedureScope(TopScope),ResolverResultVar,El,pikSimple); + if TopScope.ClassType<>TPasProcedureScope then exit; + AddIdentifier(TPasProcedureScope(TopScope),ResolverResultVar,El,pikSimple); end; procedure TPasResolver.AddExceptOn(El: TPasImplExceptOn); @@ -7488,7 +7499,7 @@ begin FLastMsgType := MsgType; FLastMsgNumber := MsgNumber; FLastMsgPattern := Fmt; - FLastMsg := Format(Fmt,Args); + FLastMsg := SafeFormat(Fmt,Args); FLastElement := Element; CreateMsgArgs(FLastMsgArgs,Args); {$IFDEF VerbosePasResolver} @@ -7500,15 +7511,17 @@ begin {$ENDIF} end; -procedure TPasResolver.RaiseMsg(const id: int64; MsgNumber: integer; +procedure TPasResolver.RaiseMsg(const Id: int64; MsgNumber: integer; const Fmt: String; Args: array of const; ErrorPosEl: TPasElement); var E: EPasResolve; begin - SetLastMsg(id,mtError,MsgNumber,Fmt,Args,ErrorPosEl); + SetLastMsg(Id,mtError,MsgNumber,Fmt,Args,ErrorPosEl); E:=EPasResolve.Create(FLastMsg); - E.PasElement:=ErrorPosEl; + E.Id:=Id; + E.MsgType:=mtError; E.MsgNumber:=MsgNumber; + E.PasElement:=ErrorPosEl; E.Args:=FLastMsgArgs; raise E; end; @@ -7576,7 +7589,7 @@ procedure TPasResolver.LogMsg(const id: int64; MsgType: TMessageType; begin SetLastMsg(id,MsgType,MsgNumber,Fmt,Args,PosEl); if Assigned(CurrentParser.OnLog) then - CurrentParser.OnLog(Self,Format(Fmt,Args)); + CurrentParser.OnLog(Self,SafeFormat(Fmt,Args)); end; function TPasResolver.CheckCallProcCompatibility(ProcType: TPasProcedureType; diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp index 85761ee789..b0dbbb28a8 100644 --- a/packages/fcl-passrc/src/pparser.pp +++ b/packages/fcl-passrc/src/pparser.pp @@ -714,7 +714,7 @@ procedure TPasParser.ParseExc(MsgNumber: integer; const Fmt: String; Args: array of const); begin SetLastMsg(mtError,MsgNumber,Fmt,Args); - raise EParserError.Create(Format(SParserErrorAtToken, + raise EParserError.Create(SafeFormat(SParserErrorAtToken, [FLastMsg, CurTokenName, Scanner.CurFilename, Scanner.CurRow, Scanner.CurColumn]) {$ifdef addlocation}+' ('+inttostr(scanner.currow)+' '+inttostr(scanner.curcolumn)+')'{$endif}, Scanner.CurFilename, Scanner.CurRow, Scanner.CurColumn); @@ -3220,7 +3220,7 @@ begin FLastMsgType := MsgType; FLastMsgNumber := MsgNumber; FLastMsgPattern := Fmt; - FLastMsg := Format(Fmt,Args); + FLastMsg := SafeFormat(Fmt,Args); CreateMsgArgs(FLastMsgArgs,Args); end; diff --git a/packages/fcl-passrc/src/pscanner.pp b/packages/fcl-passrc/src/pscanner.pp index 5ad24dc553..bf1dd6122a 100644 --- a/packages/fcl-passrc/src/pscanner.pp +++ b/packages/fcl-passrc/src/pscanner.pp @@ -700,6 +700,7 @@ function FilenameIsUnixAbsolute(const TheFilename: string): boolean; function IsNamedToken(Const AToken : String; Out T : TToken) : Boolean; procedure CreateMsgArgs(var MsgArgs: TMessageArgs; Args: array of const); +function SafeFormat(const Fmt: string; Args: array of const): string; implementation @@ -787,7 +788,6 @@ var begin SetLength(MsgArgs, High(Args)-Low(Args)+1); for i:=Low(Args) to High(Args) do - begin case Args[i].VType of vtInteger: MsgArgs[i] := IntToStr(Args[i].VInteger); vtBoolean: MsgArgs[i] := BoolToStr(Args[i].VBoolean); @@ -811,6 +811,26 @@ begin vtQWord: MsgArgs[i] := IntToStr(Args[i].VQWord^); vtUnicodeString:MsgArgs[i] := AnsiString(UnicodeString(Args[i].VUnicodeString)); end; +end; + +function SafeFormat(const Fmt: string; Args: array of const): string; +var + MsgArgs: TMessageArgs; + i: Integer; +begin + try + Result:=Format(Fmt,Args); + except + Result:=''; + MsgArgs:=nil; + CreateMsgArgs(MsgArgs,Args); + for i:=0 to length(MsgArgs)-1 do + begin + if i>0 then + Result:=Result+','; + Result:=Result+MsgArgs[i]; + end; + Result:='{'+Fmt+'}['+Result+']'; end; end; @@ -1310,8 +1330,7 @@ begin FCurToken:=tkIdentifier; Result:=FCurToken; end; - if not PPIsSkipping then - Break; + Break; end; else if not PPIsSkipping then @@ -2291,7 +2310,7 @@ begin If (TokenStr<>Nil) then Result := TokenStr - PChar(CurLine) else - Result:=0; + Result := 0; end; procedure TPascalScanner.DoLog(MsgType: TMessageType; MsgNumber: integer; @@ -2352,7 +2371,7 @@ begin FLastMsgType := MsgType; FLastMsgNumber := MsgNumber; FLastMsgPattern := Fmt; - FLastMsg := Format(Fmt,Args); + FLastMsg := SafeFormat(Fmt,Args); CreateMsgArgs(FLastMsgArgs,Args); end; diff --git a/packages/fcl-passrc/tests/tcresolver.pas b/packages/fcl-passrc/tests/tcresolver.pas index e25d3e70b0..45bb891a8a 100644 --- a/packages/fcl-passrc/tests/tcresolver.pas +++ b/packages/fcl-passrc/tests/tcresolver.pas @@ -264,6 +264,7 @@ type Procedure TestProc_UntypedParam_Forward; Procedure TestProc_Varargs; Procedure TestProc_ParameterExprAccess; + Procedure TestProc_FunctionResult_DeclProc; // ToDo: fail builtin functions in constant with non const param // record @@ -278,6 +279,7 @@ type Procedure TestClassForward; Procedure TestClassForwardNotResolved; Procedure TestClass_Method; + Procedure TestClass_MethodWithoutClassFail; Procedure TestClass_MethodWithParams; Procedure TestClass_MethodUnresolved; Procedure TestClass_MethodAbstract; @@ -671,14 +673,14 @@ var end; function AddMarkerForTokenBehindComment(Kind: TSrcMarkerKind; - const Identifer: string): PSrcMarker; + const Identifier: string): PSrcMarker; var TokenStart, p: PChar; begin p:=CommentEndP; ReadNextPascalToken(p,TokenStart,false,false); Result:=AddMarker(Kind,Filename,LineNumber, - CommentEndP-PChar(SrcLine)+1,p-PChar(SrcLine)+1,Identifer); + CommentEndP-PChar(SrcLine)+1,p-PChar(SrcLine)+1,Identifier); end; function ReadIdentifier(var p: PChar): string; @@ -3594,6 +3596,70 @@ begin CheckAccessMarkers; end; +procedure TTestResolver.TestProc_FunctionResult_DeclProc; +var + aMarker: PSrcMarker; + Elements: TFPList; + i: Integer; + El: TPasElement; + Ref: TResolvedReference; + ResultEl: TPasResultElement; + Proc: TPasProcedure; + ProcScope: TPasProcedureScope; +begin + StartProgram(false); + Add('type'); + Add(' TObject = class'); + Add(' function MethodA: longint;'); + Add(' end;'); + Add('function FuncA: longint; forward;'); + Add('function TObject.MethodA: longint;'); + Add('begin'); + Add(' {#MethodA_Result}Result:=1;'); + Add('end;'); + Add('function FuncA: longint;'); + Add(' function SubFuncA: longint; forward;'); + Add(' function SubFuncB: longint;'); + Add(' begin'); + Add(' {#SubFuncB_Result}Result:=2;'); + Add(' end;'); + Add(' function SubFuncA: longint;'); + Add(' begin'); + Add(' {#SubFuncA_Result}Result:=3;'); + Add(' end;'); + Add('begin'); + Add(' {#FuncA_Result}Result:=4;'); + Add('end;'); + Add('begin'); + ParseProgram; + aMarker:=FirstSrcMarker; + while aMarker<>nil do + begin + writeln('TTestResolver.TestProc_FunctionResult_DeclProc ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol); + Elements:=FindElementsAt(aMarker); + try + for i:=0 to Elements.Count-1 do + begin + El:=TPasElement(Elements[i]); + writeln('TTestResolver.TestProc_FunctionResult_DeclProc ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData)); + if not (El.CustomData is TResolvedReference) then continue; + Ref:=TResolvedReference(El.CustomData); + writeln('TTestResolver.TestProc_FunctionResult_DeclProc ',GetObjName(Ref.Declaration)); + if not (Ref.Declaration is TPasResultElement) then continue; + ResultEl:=TPasResultElement(Ref.Declaration); + Proc:=ResultEl.Parent as TPasProcedure; + ProcScope:=Proc.CustomData as TPasProcedureScope; + if ProcScope.DeclarationProc<>nil then + RaiseErrorAtSrcMarker('expected Result to resolve to declaration at "#'+aMarker^.Identifier+', but was implproc"',aMarker); + break; + end; + finally + Elements.Free; + end; + aMarker:=aMarker^.Next; + end; +end; + procedure TTestResolver.TestRecord; begin StartProgram(false); @@ -3774,6 +3840,19 @@ begin ParseProgram; end; +procedure TTestResolver.TestClass_MethodWithoutClassFail; +begin + StartProgram(false); + Add('type'); + Add(' TObject = class'); + Add(' end;'); + Add('procedure TClassA.ProcA;'); + Add('begin'); + Add('end;'); + Add('begin'); + CheckResolverException('identifier not found "TClassA"',nIdentifierNotFound); +end; + procedure TTestResolver.TestClass_MethodWithParams; begin StartProgram(false);