From 5f4f03d6e99053931d5f06bb42aff933d5d4cf44 Mon Sep 17 00:00:00 2001 From: mattias Date: Sat, 24 Jul 2010 08:12:27 +0000 Subject: [PATCH] IDE: using new codetools FPC caches IDE: fixed macro FPCVer for multiple versions used by fpc.exe IDE: fixed rescan of FPC sources if not changed, bug #16824 codetools: replaced fpc source heuristic with rule set, needed for bug #13912, #14572 IDE: fixed unneeded rescan of fpc sources if only target changed, needed for 12828 IDE: fixed calling compiler on every start, needed by lazarus on a stick codetools: fixed search for fpc units without ppu, needed for 15534 IDE: implemented cache for fpc include files, needed by debugger lazbuild: fixed using non default lclwidgettype of lpi IDE: fixed auto update if fpc.cfg or target compiler changed, needed for 16824 git-svn-id: trunk@26796 - --- .../lazarus/example/AggPasInLCLDemo2.lpi | 11 +- components/codetools/codetoolmanager.pas | 64 +--- components/codetools/definetemplates.pas | 151 +++++++- components/codetools/directorycacher.pas | 6 +- components/codetools/identcompletiontool.pas | 207 +++++------ components/codetools/pascalparsertool.pas | 2 +- components/synedit/test/testbase.pas | 94 +++-- ide/basebuildmanager.pas | 8 +- ide/buildmanager.pas | 339 +++++++++++------- ide/codebrowser.pas | 53 +-- ide/codetoolsdefines.pas | 83 ++--- ide/codetoolsoptions.pas | 2 +- ide/lazarusidestrconsts.pas | 2 - ide/lazbuild.lpi | 2 +- ide/lazbuild.lpr | 5 +- ide/main.pp | 147 ++------ ide/outputfilter.pas | 13 +- 17 files changed, 638 insertions(+), 551 deletions(-) diff --git a/components/aggpas/lazarus/example/AggPasInLCLDemo2.lpi b/components/aggpas/lazarus/example/AggPasInLCLDemo2.lpi index feefb27239..90f3a28530 100644 --- a/components/aggpas/lazarus/example/AggPasInLCLDemo2.lpi +++ b/components/aggpas/lazarus/example/AggPasInLCLDemo2.lpi @@ -1,7 +1,7 @@ - + @@ -9,7 +9,7 @@ </General> <VersionInfo> - <ProjectVersion Value=""/> + <StringTable Comments="" CompanyName="" FileDescription="" FileVersion="0.0.0.0" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion=""/> </VersionInfo> <PublishOptions> <Version Value="2"/> @@ -48,10 +48,15 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="9"/> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)/"/> </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> <Linking> <Options> <Win32> diff --git a/components/codetools/codetoolmanager.pas b/components/codetools/codetoolmanager.pas index 5104631ee4..6cb23add7e 100644 --- a/components/codetools/codetoolmanager.pas +++ b/components/codetools/codetoolmanager.pas @@ -298,7 +298,7 @@ type function GetUnitLinksForDirectory(const Directory: string; UseCache: boolean = false): string; function FindUnitInUnitSet(const Directory, AUnitName: string): string; - function GetUnitSetForDirectory(const Directory: string; + function GetUnitSetIDForDirectory(const Directory: string; UseCache: boolean = false): string; function GetFPCUnitPathForDirectory(const Directory: string; UseCache: boolean = false): string;// unit paths reported by FPC @@ -912,15 +912,7 @@ var FPCSrcDefines: TDefineTemplate; LazarusSrcDefines: TDefineTemplate; CurFPCOptions: String; - {$IFDEF EnableFPCCache} UnitSetCache: TFPCUnitSetCache; - {$ELSE} - FPCUnitPath: String; - TargetOS: String; - TargetProcessor: String; - ATestPascalFile: String; - UnitLinkList: String; - {$ENDIF} procedure AddFPCOption(s: string); begin @@ -939,7 +931,6 @@ begin Variables[ExternalMacroStart+'ProjectDir']:=Config.ProjectDir; end; - {$IFDEF EnableFPCCache} FPCDefinesCache.ConfigCaches.Assign(Config.ConfigCaches); FPCDefinesCache.SourceCaches.Assign(Config.SourceCaches); FPCDefinesCache.TestFilename:=Config.TestPascalFile; @@ -972,55 +963,6 @@ begin // save Config.ConfigCaches.Assign(FPCDefinesCache.ConfigCaches); Config.SourceCaches.Assign(FPCDefinesCache.SourceCaches); - {$ELSE} - - // build DefinePool - FPCUnitPath:=Config.FPCUnitPath; - TargetOS:=Config.TargetOS; - TargetProcessor:=Config.TargetProcessor; - ATestPascalFile:=Config.TestPascalFile; - if ATestPascalFile='' then - ATestPascalFile:=GetTempFilename('fpctest.pas',''); - CurFPCOptions:=Config.FPCOptions; - with DefinePool do begin - if TargetOS<>'' then AddFPCOption('-T'+TargetOS); - if TargetProcessor<>'' then AddFPCOption('-P'+TargetProcessor); - FPCDefines:=CreateFPCTemplate(Config.FPCPath, CurFPCOptions, - ATestPascalFile, - FPCUnitPath, TargetOS, TargetProcessor, - nil); - if Config.TargetOS='' then - Config.TargetOS:=TargetOS; - if Config.TargetProcessor='' then - Config.TargetProcessor:=TargetProcessor; - if FPCDefines=nil then begin - raise Exception.Create('TCodeToolManager.Init: Unable to execute '+Config.FPCPath+' to get compiler values'); - end; - Add(FPCDefines); - Config.FPCUnitPath:=FPCUnitPath; - Config.TargetOS:=TargetOS; - Config.TargetProcessor:=TargetProcessor; - UnitLinkList:=Config.UnitLinkList; - FPCSrcDefines:=CreateFPCSrcTemplate(Config.FPCSrcDir,Config.FPCUnitPath, - Config.PPUExt, - Config.TargetOS, Config.TargetProcessor, - Config.UnitLinkListValid,UnitLinkList, - nil); - Add(FPCSrcDefines); - Config.UnitLinkListValid:=UnitLinkList<>''; - Config.UnitLinkList:=UnitLinkList; - LazarusSrcDefines:=CreateLazarusSrcTemplate('$(#LazarusSrcDir)', - '$(#LCLWidgetType)', - Config.LazarusSrcOptions,nil); - Add(LazarusSrcDefines); - end; - // build define tree - DefineTree.Add(FPCDefines.CreateCopy); - DefineTree.Add(FPCSrcDefines.CreateCopy); - DefineTree.Add(LazarusSrcDefines.CreateCopy); - DefineTree.Add(DefinePool.CreateLCLProjectTemplate( - '$(#LazarusSrcDir)','$(#LCLWidgetType)','$(#ProjectDir)',nil)); - {$ENDIF} end; procedure TCodeToolManager.SimpleInit(const ConfigFilename: string); @@ -1492,7 +1434,7 @@ begin Result:=DirectoryCachePool.FindUnitInUnitSet(Directory,AUnitName); end; -function TCodeToolManager.GetUnitSetForDirectory(const Directory: string; +function TCodeToolManager.GetUnitSetIDForDirectory(const Directory: string; UseCache: boolean): string; var Evaluator: TExpressionEvaluator; @@ -5286,7 +5228,7 @@ begin ctdcsIncludePath: Result:=GetIncludePathForDirectory(ADirectory,false); ctdcsCompleteSrcPath: Result:=GetCompleteSrcPathForDirectory(ADirectory,false); ctdcsUnitLinks: Result:=GetUnitLinksForDirectory(ADirectory,false); - ctdcsUnitSet: Result:=GetUnitSetForDirectory(ADirectory,false); + ctdcsUnitSet: Result:=GetUnitSetIDForDirectory(ADirectory,false); ctdcsFPCUnitPath: Result:=GetFPCUnitPathForDirectory(ADirectory,false); else RaiseCatchableException(''); end; diff --git a/components/codetools/definetemplates.pas b/components/codetools/definetemplates.pas index 825e430e57..9b92b35b2d 100644 --- a/components/codetools/definetemplates.pas +++ b/components/codetools/definetemplates.pas @@ -697,6 +697,7 @@ type function NeedsUpdate: boolean; function Update(TestFilename: string; ExtraOptions: string = ''; const OnProgress: TDefinePoolProgress = nil): boolean; + function GetFPCVer(out FPCVersion, FPCRelease, FPCPatch: integer): boolean; procedure IncreaseChangeStamp; property ChangeStamp: integer read FChangeStamp; end; @@ -830,6 +831,7 @@ type function GetSourceDuplicates(AutoUpdate: boolean): TStringToStringTree; // lower case unit to semicolon separated list of files function GetUnitSrcFile(const AUnitName: string): string; property ChangeStamp: integer read FChangeStamp; + function GetInvalidChangeStamp: integer; procedure IncreaseChangeStamp; function GetUnitSetID: string; end; @@ -840,6 +842,7 @@ type private FConfigCaches: TFPCTargetConfigCaches; FConfigCachesSaveStamp: integer; + FExtraOptions: string; FSourceCaches: TFPCSourceCaches; FSourceCachesSaveStamp: integer; FTestFilename: string; @@ -859,6 +862,7 @@ type property SourceCaches: TFPCSourceCaches read FSourceCaches write SetSourceCaches; property ConfigCaches: TFPCTargetConfigCaches read FConfigCaches write SetConfigCaches; property TestFilename: string read FTestFilename write FTestFilename; // an empty file to test the compiler, will be auto created + property ExtraOptions: string read FExtraOptions write FExtraOptions; // additional compiler options not used as key function FindUnitSet(const CompilerFilename, TargetOS, TargetCPU, Options, FPCSrcDir: string; CreateIfNotExists: boolean): TFPCUnitSetCache; @@ -888,6 +892,7 @@ function CreateDefinesInDirectories(const SourcePaths, FlagName: string function GatherFiles(Directory, ExcludeDirMask, IncludeFileMask: string; const OnProgress: TDefinePoolProgress): TStringList; +function MakeRelativeFileList(Files: TStrings; out BaseDir: string): TStringList; function Compress1FileList(Files: TStrings): TStringList; function Decompress1FileList(Files: TStrings): TStringList; function RunTool(const Filename, Params: string; @@ -896,6 +901,8 @@ function ParseFPCInfo(FPCInfo: string; InfoTypes: TFPCInfoTypes; out Infos: TFPCInfoStrings): boolean; function RunFPCInfo(const CompilerFilename: string; InfoTypes: TFPCInfoTypes; const Options: string =''): string; +function SplitFPCVersion(const FPCVersionString: string; + out FPCVersion, FPCRelease, FPCPatch: integer): boolean; function ParseFPCVerbose(List: TStrings; // fpc -va output out ConfigFiles: TStrings; // prefix '-' for file not found, '+' for found and read out CompilerFilename: string; // what compiler is used by fpc @@ -1063,6 +1070,46 @@ begin end; end; +function MakeRelativeFileList(Files: TStrings; out BaseDir: string + ): TStringList; +var + BaseDirLen: Integer; + i: Integer; + Filename: string; +begin + BaseDir:=''; + Result:=TStringList.Create; + if (Files=nil) or (Files.Count=0) then exit; + Result.Assign(Files); + // delete empty lines + for i:=Result.Count-1 downto 0 do + if Result[i]='' then Result.Delete(i); + if Result.Count=0 then exit; + // find shortest common BaseDir + BaseDir:=ChompPathDelim(ExtractFilepath(Result[0])); + BaseDirLen:=length(BaseDir); + for i:=1 to Result.Count-1 do begin + Filename:=Result[i]; + while (BaseDirLen>0) do begin + if (BaseDirLen<=length(Filename)) + and ((BaseDirLen=length(Filename)) or (Filename[BaseDirLen+1]=PathDelim)) + and (CompareFilenames(BaseDir,copy(Filename,1,BaseDirLen))=0) then + break; + BaseDir:=ChompPathDelim(ExtractFilePath(copy(BaseDir,1,BaseDirLen-1))); + BaseDirLen:=length(BaseDir); + end; + end; + // create relative paths + if BaseDir<>'' then + for i:=0 to Result.Count-1 do begin + Filename:=Result[i]; + Filename:=copy(Filename,BaseDirLen+1,length(Filename)); + if (Filename<>'') and (Filename[1]=PathDelim) then + System.Delete(Filename,1,1); + Result[i]:=Filename; + end; +end; + function Compress1FileList(Files: TStrings): TStringList; var i: Integer; @@ -1124,6 +1171,7 @@ begin if not FileIsExecutable(Filename) then exit(nil); Result:=TStringList.Create; try + debugln(['RunTool ',Filename,' ',Params]); TheProcess := TProcess.Create(nil); try CmdLine:=UTF8ToSys(Filename); @@ -1218,6 +1266,44 @@ begin end; end; +function SplitFPCVersion(const FPCVersionString: string; out FPCVersion, + FPCRelease, FPCPatch: integer): boolean; +// for example 2.5.1 +var + p: PChar; + + function ReadWord(out v: integer): boolean; + var + Empty: Boolean; + begin + v:=0; + Empty:=true; + while (p^ in ['0'..'9']) do begin + if v>10000 then exit(false); + v:=v*10+ord(p^)-ord('0'); + inc(p); + Empty:=false; + end; + Result:=not Empty; + end; + +begin + Result:=false; + FPCVersion:=0; + FPCRelease:=0; + FPCPatch:=0; + if FPCVersionString='' then exit; + p:=PChar(FPCVersionString); + if not ReadWord(FPCVersion) then exit; + if (p^<>'.') then exit; + inc(p); + if not ReadWord(FPCRelease) then exit; + if (p^<>'.') then exit; + inc(p); + if not ReadWord(FPCPatch) then exit; + Result:=true; +end; + function ParseFPCVerbose(List: TStrings; out ConfigFiles: TSTrings; out CompilerFilename: string; out UnitPaths: TStrings; out Defines, Undefines: TStringToStringTree): boolean; @@ -4704,7 +4790,7 @@ begin if CompilerOptions<>'' then CmdLine:=CmdLine+CompilerOptions+' '; CmdLine:=CmdLine+TestPascalFile; - //DebugLn('TDefinePool.CreateFPCTemplate CmdLine="',CmdLine,'"'); + DebugLn('TDefinePool.CreateFPCTemplate CmdLine="',CmdLine,'"'); TheProcess := TProcess.Create(nil); TheProcess.CommandLine := UTF8ToSys(CmdLine); @@ -7117,6 +7203,7 @@ var UnitList: TStringList; Unit_Name: String; Filename: String; + BaseDir: String; begin Clear; @@ -7171,6 +7258,16 @@ begin List.StrictDelimiter:=true; List.DelimitedText:=s; UnitPaths:=Decompress1FileList(List); + BaseDir:=TrimFilename(AppendPathDelim(XMLConfig.GetValue(Path+'UnitPaths/BaseDir',''))); + if BaseDir<>'' then + for i:=0 to UnitPaths.Count-1 do + UnitPaths[i]:=ChompPathDelim(TrimFilename(BaseDir+UnitPaths[i])) + else + for i:=UnitPaths.Count-1 downto 0 do + if UnitPaths[i]='' then + UnitPaths.Delete(i) + else + UnitPaths[i]:=ChompPathDelim(TrimFilename(UnitPaths[i])); // do not sort, order is important (e.g. for httpd.ppu) finally List.Free; @@ -7178,7 +7275,7 @@ begin // units: format: Units/Values semicolon separated list of compressed filename List:=TStringList.Create; - UnitList:=TStringList.Create; + UnitList:=nil; try s:=XMLConfig.GetValue(Path+'Units/Value',''); List.Delimiter:=';'; @@ -7213,6 +7310,8 @@ var Filename: String; List: TStringList; s: String; + BaseDir: string; + RelativeUnitPaths: TStringList; begin XMLConfig.SetDeleteValue(Path+'TargetOS',TargetOS,''); XMLConfig.SetDeleteValue(Path+'TargetCPU',TargetCPU,''); @@ -7259,18 +7358,23 @@ begin // UnitPaths: write as semicolon separated compressed list s:=''; + BaseDir:=''; if UnitPaths<>nil then begin - List:=TStringList.Create; + List:=nil; + RelativeUnitPaths:=nil; try - List:=Compress1FileList(UnitPaths); + RelativeUnitPaths:=MakeRelativeFileList(UnitPaths,BaseDir); + List:=Compress1FileList(RelativeUnitPaths); // do not sort, order is important (e.g. for httpd.ppu) List.Delimiter:=';'; List.StrictDelimiter:=true; s:=List.DelimitedText; finally + RelativeUnitPaths.Free; List.Free; end; end; + XMLConfig.SetDeleteValue(Path+'UnitPaths/BaseDir',BaseDir,''); XMLConfig.SetDeleteValue(Path+'UnitPaths/Value',s,''); // Units: Units/Values semicolon separated list of compressed filenames @@ -7395,6 +7499,7 @@ begin OldOptions.Assign(Self); Clear; + debugln(['TFPCTargetConfigCache.Update ',Compiler,' TargetOS=',TargetOS,' TargetCPU=',TargetCPU,' CompilerOptions=',CompilerOptions,' ExtraOptions=',ExtraOptions]); CompilerDate:=FileAgeCached(Compiler); if FileExistsCached(Compiler) then begin @@ -7415,6 +7520,8 @@ begin // run fpc and parse output RunFPCVerbose(Compiler,TestFilename,CfgFiles,RealCompiler,UnitPaths, Defines,Undefines,ExtraOptions); + for i:=0 to UnitPaths.Count-1 do + UnitPaths[i]:=ChompPathDelim(TrimFilename(UnitPaths[i])); // store the real compiler file and date if (RealCompiler<>'') and FileExistsCached(RealCompiler) then RealCompilerDate:=FileAgeCached(RealCompiler); @@ -7440,8 +7547,10 @@ begin end; end; // check for changes - if not Equals(OldOptions) then + if not Equals(OldOptions) then begin IncreaseChangeStamp; + debugln(['TFPCTargetConfigCache.Update: has changed']); + end; Result:=true; finally CfgFiles.Free; @@ -7449,6 +7558,20 @@ begin end; end; +function TFPCTargetConfigCache.GetFPCVer(out FPCVersion, FPCRelease, + FPCPatch: integer): boolean; +var + v: string; +begin + v:={$I %FPCVERSION%}; + Result:=SplitFPCVersion(v,FPCVersion,FPCRelease,FPCPatch); + if Defines<>nil then begin + FPCVersion:=StrToIntDef(Defines['FPC_VERSION'],FPCVersion); + FPCRelease:=StrToIntDef(Defines['FPC_RELEASE'],FPCRelease); + FPCPatch:=StrToIntDef(Defines['FPC_PATCH'],FPCPatch); + end; +end; + { TFPCTargetConfigCaches } constructor TFPCTargetConfigCaches.Create(AOwner: TComponent); @@ -7852,12 +7975,15 @@ begin Files:=nil; try if (Directory<>'') then begin + debugln(['TFPCSourceCache.Update ',Directory,' ...']); Files:=GatherFiles(Directory,'{.svn,CVS}', '{*.pas,*.pp,*.p,*.inc,Makefile.fpc}',OnProgress); end; if ((Files=nil)<>(OldFiles=nil)) - or ((Files<>nil) and (Files.Text<>OldFiles.Text)) then + or ((Files<>nil) and (Files.Text<>OldFiles.Text)) then begin IncreaseChangeStamp; + debugln(['TFPCSourceCache.Update ',Directory,' has changed.']); + end; finally OldFiles.Free; end; @@ -8095,6 +8221,7 @@ end; procedure TFPCDefinesCache.SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string); begin + debugln(['TFPCDefinesCache.SaveToXMLConfig ']); if ConfigCaches<>nil then begin ConfigCaches.SaveToXMLConfig(XMLConfig,Path+'FPCConfigs/'); FConfigCachesSaveStamp:=ConfigCaches.ChangeStamp; @@ -8372,7 +8499,7 @@ begin FConfigCache.FreeNotification(Self); end; if AutoUpdate and FConfigCache.NeedsUpdate then - FConfigCache.Update(Caches.TestFilename); + FConfigCache.Update(Caches.TestFilename,Caches.ExtraOptions); Result:=FConfigCache; end; @@ -8436,6 +8563,7 @@ begin NewSrcDuplicates,SrcRules); if NewUnitToSourceTree=nil then NewUnitToSourceTree:=TStringToStringTree.Create(true); + // ToDo: add/replace sources in FPC search paths if not fUnitToSourceTree.Equals(NewUnitToSourceTree) then begin fUnitToSourceTree.Assign(NewUnitToSourceTree); IncreaseChangeStamp; @@ -8472,6 +8600,15 @@ begin Result:=FPCSourceDirectory+Tree[LowerCase(AUnitName)]; end; +function TFPCUnitSetCache.GetInvalidChangeStamp: integer; +begin + Result:=ChangeStamp; + if Result>Low(Result) then + dec(Result) + else + Result:=High(Result); +end; + procedure TFPCUnitSetCache.IncreaseChangeStamp; begin if FChangeStamp<High(FChangeStamp) then diff --git a/components/codetools/directorycacher.pas b/components/codetools/directorycacher.pas index c1403a0313..21fae1d8c0 100644 --- a/components/codetools/directorycacher.pas +++ b/components/codetools/directorycacher.pas @@ -731,7 +731,7 @@ begin UnitSet:=Strings[ctdcsUnitSet]; //debugln(['TCTDirectoryCache.FindUnitInUnitSet Directory="',Directory,'" UnitSet="',UnitSet,'" AUnitName="',AUnitName,'"']); Result:=Pool.OnGetUnitFromSet(UnitSet,AUnitName); - debugln(['TCTDirectoryCache.FindUnitInUnitSet Directory="',Directory,'" UnitSet="',dbgstr(UnitSet),'" AUnitName="',AUnitName,'" Result="',Result,'"']); + //debugln(['TCTDirectoryCache.FindUnitInUnitSet Directory="',Directory,'" UnitSet="',dbgstr(UnitSet),'" AUnitName="',AUnitName,'" Result="',Result,'"']); end; function TCTDirectoryCache.FindFile(const ShortFilename: string; @@ -1023,11 +1023,7 @@ begin {$IFDEF ShowTriedUnits} DebugLn(['TCTDirectoryCache.FindUnitSourceInCompletePath unit ',AUnitName,' not found in SrcPath="',SrcPath,'" Directory="',Directory,'"']); {$ENDIF} - {$IFDEF EnableFPCCache} Result:=FindUnitInUnitSet(AUnitName); - {$ELSE} - Result:=FindUnitLink(AUnitName); - {$ENDIF} {$IFDEF ShowTriedUnits} if Result='' then begin DebugLn(['TCTDirectoryCache.FindUnitSourceInCompletePath unit ',AUnitName,' not found in unitlinks. Directory="',Directory,'"']); diff --git a/components/codetools/identcompletiontool.pas b/components/codetools/identcompletiontool.pas index 29a9b7ada9..d7ef39b168 100644 --- a/components/codetools/identcompletiontool.pas +++ b/components/codetools/identcompletiontool.pas @@ -324,15 +324,17 @@ type TIdentCompletionTool = class(TFindDeclarationTool) private - LastGatheredIdentParent: TCodeTreeNode; - LastGatheredIdentLevel: integer; - ClassAndAncestors: TFPList;// list of PCodeXYPosition - FoundPublicProperties: TAVLTree;// tree of PChar (pointing to the + FLastGatheredIdentParent: TCodeTreeNode; + FLastGatheredIdentLevel: integer; + FICTClassAndAncestors: TFPList;// list of PCodeXYPosition + FIDCTFoundPublicProperties: TAVLTree;// tree of PChar (pointing to the // property names in source) - FoundMethods: TAVLTree;// tree of TCodeTreeNodeExtension Txt=clean text + FIDTFoundMethods: TAVLTree;// tree of TCodeTreeNodeExtension Txt=clean text + FIDTTreeOfUnitFiles: TAVLTree;// tree of TUnitFileInfo + procedure AddToTreeOfUnitFileInfo(const AFilename: string); protected CurrentIdentifierList: TIdentifierList; - CurrentContexts: TCodeContextInfo; + CurrentIdentifierContexts: TCodeContextInfo; function CollectAllIdentifiers(Params: TFindDeclarationParams; const FoundContext: TFindContext): TIdentifierFoundResult; procedure GatherPredefinedIdentifiers(CleanPos: integer; @@ -878,6 +880,11 @@ end; { TIdentCompletionTool } +procedure TIdentCompletionTool.AddToTreeOfUnitFileInfo(const AFilename: string); +begin + AddToTreeOfUnitFiles(FIDTTreeOfUnitFiles,AFilename,false); +end; + function TIdentCompletionTool.CollectAllIdentifiers( Params: TFindDeclarationParams; const FoundContext: TFindContext ): TIdentifierFoundResult; @@ -890,7 +897,7 @@ var CurClassNode: TCodeTreeNode; p: TFindContext; begin - if ClassAndAncestors<>nil then begin + if FICTClassAndAncestors<>nil then begin // start of the identifier completion is in a method or class // => all protected ancestor classes are allowed as well. CurClassNode:=FoundContext.Node; @@ -899,7 +906,7 @@ var CurClassNode:=CurClassNode.Parent; if CurClassNode=nil then exit; p:=CreateFindContext(Params.NewCodeTool,CurClassNode); - if IndexOfFindContext(ClassAndAncestors,@p)>=0 then begin + if IndexOfFindContext(FICTClassAndAncestors,@p)>=0 then begin // this class node is the class or one of the ancestors of the class // of the start context of the identifier completion exit(true); @@ -913,9 +920,9 @@ var function PropertyIsOverridenPublicPublish: boolean; begin // protected properties can be made public in child classes. - //debugln('PropertyIsOverridenPublicPublish Identifier=',GetIdentifier(Ident),' Find=',dbgs((FoundPublicProperties<>nil) and (FoundPublicProperties.Find(Ident)<>nil))); - if FoundPublicProperties<>nil then begin - if FoundPublicProperties.Find(Ident)<>nil then begin + //debugln('PropertyIsOverridenPublicPublish Identifier=',GetIdentifier(Ident),' Find=',dbgs((FIDCTFoundPublicProperties<>nil) and (FIDCTFoundPublicProperties.Find(Ident)<>nil))); + if FIDCTFoundPublicProperties<>nil then begin + if FIDCTFoundPublicProperties.Find(Ident)<>nil then begin // there is a public/published property with the same name exit(true); end; @@ -925,16 +932,16 @@ var procedure SavePublicPublishedProperty; begin - if FoundPublicProperties=nil then begin + if FIDCTFoundPublicProperties=nil then begin // create tree - FoundPublicProperties:= + FIDCTFoundPublicProperties:= TAVLTree.Create(TListSortCompare(@CompareIdentifiers)) - end else if FoundPublicProperties.Find(Ident)<>nil then begin + end else if FIDCTFoundPublicProperties.Find(Ident)<>nil then begin // identifier is already public exit; end; - FoundPublicProperties.Add(Ident); - //debugln('SavePublicPublishedProperty Identifier=',GetIdentifier(Ident),' Find=',dbgs(FoundPublicProperties.Find(Ident)<>nil)); + FIDCTFoundPublicProperties.Add(Ident); + //debugln('SavePublicPublishedProperty Identifier=',GetIdentifier(Ident),' Find=',dbgs(FIDCTFoundPublicProperties.Find(Ident)<>nil)); end; var @@ -953,10 +960,10 @@ begin {$ENDIF} CurContextParent:=FoundContext.Node.GetFindContextParent; - if LastGatheredIdentParent<>CurContextParent then begin + if FLastGatheredIdentParent<>CurContextParent then begin // new context level - LastGatheredIdentParent:=CurContextParent; - inc(LastGatheredIdentLevel); + FLastGatheredIdentParent:=CurContextParent; + inc(FLastGatheredIdentLevel); end; ProtectedForeignClass:=false; @@ -1074,7 +1081,7 @@ begin false, 0, Ident, - LastGatheredIdentLevel, + FLastGatheredIdentLevel, FoundContext.Node, FoundContext.Tool, ctnNone); @@ -1394,47 +1401,13 @@ end; procedure TIdentCompletionTool.GatherUnitnames(CleanPos: integer; const Context: TFindContext; BeautifyCodeOptions: TBeautifyCodeOptions); -var - TreeOfUnitFiles: TAVLTree; - {$IFDEF EnableFPCCache} procedure GatherUnitsFromSet; begin // collect all unit files in fpc unit paths - //DirectoryCache.IterateFPCUnitsInSet(); + DirectoryCache.IterateFPCUnitsInSet(@AddToTreeOfUnitFileInfo); end; - {$ELSE} - procedure GatherUnitsFromUnitLinks; - var - UnitLinks: string; - UnitLinkStart: Integer; - UnitLinkEnd: LongInt; - UnitLinkLen: Integer; - Filename: String; - begin - UnitLinks:=Scanner.Values[ExternalMacroStart+'UnitLinks']; - UnitLinkStart:=1; - while UnitLinkStart<=length(UnitLinks) do begin - while (UnitLinkStart<=length(UnitLinks)) - and (UnitLinks[UnitLinkStart] in [#10,#13]) do - inc(UnitLinkStart); - UnitLinkEnd:=UnitLinkStart; - while (UnitLinkEnd<=length(UnitLinks)) and (UnitLinks[UnitLinkEnd]<>' ') - do - inc(UnitLinkEnd); - UnitLinkLen:=UnitLinkEnd-UnitLinkStart; - if UnitLinkLen>0 then begin - Filename:=copy(UnitLinks,UnitLinkStart,UnitLinkEnd-UnitLinkStart); - AddToTreeOfUnitFiles(TreeOfUnitFiles,Filename,false); - end; - UnitLinkStart:=UnitLinkEnd+1; - while (UnitLinkStart<=length(UnitLinks)) - and (not (UnitLinks[UnitLinkStart] in [#10,#13])) do - inc(UnitLinkStart); - end; - end; - {$ENDIF} - + var UnitPath, SrcPath: string; BaseDir: String; @@ -1450,27 +1423,23 @@ begin GatherUnitAndSrcPath(UnitPath,SrcPath); //DebugLn('TIdentCompletionTool.GatherUnitnames UnitPath="',UnitPath,'" SrcPath="',SrcPath,'"'); BaseDir:=ExtractFilePath(MainFilename); - TreeOfUnitFiles:=nil; + FIDTTreeOfUnitFiles:=nil; try // search in unitpath UnitExt:='pp;pas;ppu'; if Scanner.CompilerMode=cmMacPas then UnitExt:=UnitExt+';p'; - GatherUnitFiles(BaseDir,UnitPath,UnitExt,false,true,TreeOfUnitFiles); + GatherUnitFiles(BaseDir,UnitPath,UnitExt,false,true,FIDTTreeOfUnitFiles); // search in srcpath SrcExt:='pp;pas'; if Scanner.CompilerMode=cmMacPas then SrcExt:=SrcExt+';p'; - GatherUnitFiles(BaseDir,SrcPath,SrcExt,false,true,TreeOfUnitFiles); + GatherUnitFiles(BaseDir,SrcPath,SrcExt,false,true,FIDTTreeOfUnitFiles); // add unitlinks - {$IFDEF EnableFPCCache} GatherUnitsFromSet; - {$ELSE} - GatherUnitsFromUnitLinks; - {$ENDIF} // create list CurSourceName:=GetSourceName; - ANode:=TreeOfUnitFiles.FindLowest; + ANode:=FIDTTreeOfUnitFiles.FindLowest; while ANode<>nil do begin UnitFileInfo:=TUnitFileInfo(ANode.Data); if CompareIdentifiers(PChar(Pointer(UnitFileInfo.FileUnitName)), @@ -1482,10 +1451,10 @@ begin 0,nil,nil,ctnUnit); CurrentIdentifierList.Add(NewItem); end; - ANode:=TreeOfUnitFiles.FindSuccessor(ANode); + ANode:=FIDTTreeOfUnitFiles.FindSuccessor(ANode); end; finally - FreeTreeOfUnitFiles(TreeOfUnitFiles); + FreeTreeOfUnitFiles(FIDTTreeOfUnitFiles); end; end; @@ -1700,8 +1669,8 @@ begin if IdentifierList=nil then IdentifierList:=TIdentifierList.Create; CurrentIdentifierList:=IdentifierList; CurrentIdentifierList.Clear; - LastGatheredIdentParent:=nil; - LastGatheredIdentLevel:=0; + FLastGatheredIdentParent:=nil; + FLastGatheredIdentLevel:=0; CurrentIdentifierList.StartContextPos:=CursorPos; StartContext := CurrentIdentifierList.StartContext; StartContext.Tool := Self; @@ -1846,30 +1815,30 @@ begin case FoundContext.Node.Desc of ctnProcedure: begin - //DebugLn('TIdentCompletionTool.CollectAllContexts CurrentContexts.ProcNameAtom.StartPos=',dbgs(CurrentContexts.ProcNameAtom.StartPos)); - if (CurrentContexts.ProcName='') then exit; + //DebugLn('TIdentCompletionTool.CollectAllContexts CurrentContexts.ProcNameAtom.StartPos=',dbgs(CurrentIdentifierContexts.ProcNameAtom.StartPos)); + if (CurrentIdentifierContexts.ProcName='') then exit; FoundContext.Tool.MoveCursorToProcName(FoundContext.Node,true); //DebugLn(['TIdentCompletionTool.CollectAllContexts ProcName=',GetIdentifier(@FoundContext.Tool.Src[FoundContext.Tool.CurPos.StartPos])]); if not FoundContext.Tool.CompareSrcIdentifiers( FoundContext.Tool.CurPos.StartPos, - PChar(CurrentContexts.ProcName)) + PChar(CurrentIdentifierContexts.ProcName)) then exit; end; ctnProperty: begin - if (CurrentContexts.ProcName='') then exit; + if (CurrentIdentifierContexts.ProcName='') then exit; FoundContext.Tool.MoveCursorToPropName(FoundContext.Node); if not FoundContext.Tool.CompareSrcIdentifiers( FoundContext.Tool.CurPos.StartPos, - PChar(CurrentContexts.ProcName)) + PChar(CurrentIdentifierContexts.ProcName)) then exit; end; ctnVarDefinition: begin - if (CurrentContexts.ProcName='') then exit; + if (CurrentIdentifierContexts.ProcName='') then exit; if not FoundContext.Tool.CompareSrcIdentifiers( FoundContext.Node.StartPos, - PChar(CurrentContexts.ProcName)) + PChar(CurrentIdentifierContexts.ProcName)) then exit; end; else @@ -1882,24 +1851,24 @@ end; procedure TIdentCompletionTool.AddCollectionContext(Tool: TFindDeclarationTool; Node: TCodeTreeNode); begin - if CurrentContexts=nil then - CurrentContexts:=TCodeContextInfo.Create; - CurrentContexts.Add(CreateExpressionType(xtContext,xtNone, + if CurrentIdentifierContexts=nil then + CurrentIdentifierContexts:=TCodeContextInfo.Create; + CurrentIdentifierContexts.Add(CreateExpressionType(xtContext,xtNone, CreateFindContext(Tool,Node))); //DebugLn('TIdentCompletionTool.AddCollectionContext ',Node.DescAsString,' ',ExtractNode(Node,[])); end; procedure TIdentCompletionTool.InitFoundMethods; begin - if FoundMethods<>nil then ClearFoundMethods; - FoundMethods:=TAVLTree.Create(@CompareCodeTreeNodeExt); + if FIDTFoundMethods<>nil then ClearFoundMethods; + FIDTFoundMethods:=TAVLTree.Create(@CompareCodeTreeNodeExt); end; procedure TIdentCompletionTool.ClearFoundMethods; begin - if FoundMethods=nil then exit; - NodeExtMemManager.DisposeAVLTree(FoundMethods); - FoundMethods:=nil; + if FIDTFoundMethods=nil then exit; + NodeExtMemManager.DisposeAVLTree(FIDTFoundMethods); + FIDTFoundMethods:=nil; end; function TIdentCompletionTool.CollectMethods( @@ -1922,7 +1891,7 @@ begin if FoundContext.Node.Desc=ctnProcedure then begin ProcText:=FoundContext.Tool.ExtractProcHead(FoundContext.Node, [phpWithoutClassKeyword,phpWithHasDefaultValues]); - AVLNode:=FindCodeTreeNodeExtAVLNode(FoundMethods,ProcText); + AVLNode:=FindCodeTreeNodeExtAVLNode(FIDTFoundMethods,ProcText); if AVLNode<>nil then begin // method is overriden => ignore end else begin @@ -1931,7 +1900,7 @@ begin NodeExt.Node:=FoundContext.Node; NodeExt.Data:=FoundContext.Tool; NodeExt.Txt:=ProcText; - FoundMethods.Add(NodeExt); + FIDTFoundMethods.Add(NodeExt); end; end; end; @@ -2024,7 +1993,7 @@ begin GatherSourceNames(GatherContext); end else begin // find class and ancestors if existing (needed for protected identifiers) - FindContextClassAndAncestors(IdentStartXY,ClassAndAncestors); + FindContextClassAndAncestors(IdentStartXY,FICTClassAndAncestors); FindCollectionContext(Params,IdentStartPos,CursorNode, GatherContext,ContextExprStartPos,StartInSubContext); @@ -2179,8 +2148,8 @@ begin Result:=true; finally - FreeListOfPFindContext(ClassAndAncestors); - FreeAndNil(FoundPublicProperties); + FreeListOfPFindContext(FICTClassAndAncestors); + FreeAndNil(FIDCTFoundPublicProperties); Params.Free; ClearIgnoreErrorAfter; DeactivateGlobalWriteLock; @@ -2301,23 +2270,23 @@ var // it is a parameter -> create context Result:=true; - if CurrentContexts=nil then - CurrentContexts:=TCodeContextInfo.Create; - CurrentContexts.Tool:=Self; - CurrentContexts.ParameterIndex:=ParameterIndex+1; - CurrentContexts.ProcNameAtom:=ProcNameAtom; - CurrentContexts.ProcName:=GetAtom(ProcNameAtom); + if CurrentIdentifierContexts=nil then + CurrentIdentifierContexts:=TCodeContextInfo.Create; + CurrentIdentifierContexts.Tool:=Self; + CurrentIdentifierContexts.ParameterIndex:=ParameterIndex+1; + CurrentIdentifierContexts.ProcNameAtom:=ProcNameAtom; + CurrentIdentifierContexts.ProcName:=GetAtom(ProcNameAtom); - AddPredefinedProcs(CurrentContexts,ProcNameAtom); + AddPredefinedProcs(CurrentIdentifierContexts,ProcNameAtom); MoveCursorToAtomPos(ProcNameAtom); ReadNextAtom; // read opening bracket - CurrentContexts.StartPos:=CurPos.EndPos; + CurrentIdentifierContexts.StartPos:=CurPos.EndPos; // read closing bracket if ReadTilBracketClose(false) then - CurrentContexts.EndPos:=CurPos.StartPos + CurrentIdentifierContexts.EndPos:=CurPos.StartPos else - CurrentContexts.EndPos:=SrcLen+1; + CurrentIdentifierContexts.EndPos:=SrcLen+1; FindCollectionContext(Params,ProcNameAtom.StartPos,CursorNode, GatherContext,ContextExprStartPos,StartInSubContext); @@ -2345,7 +2314,7 @@ begin Result:=false; IdentifierList:=nil; - CurrentContexts:=CodeContexts; + CurrentIdentifierContexts:=CodeContexts; ActivateGlobalWriteLock; Params:=TFindDeclarationParams.Create; @@ -2357,7 +2326,7 @@ begin if IdentEndPos=0 then ; // find class and ancestors if existing (needed for protected identifiers) - FindContextClassAndAncestors(CursorPos,ClassAndAncestors); + FindContextClassAndAncestors(CursorPos,FICTClassAndAncestors); if CursorNode<>nil then begin if not CheckContextIsParameter(Result) then begin @@ -2366,7 +2335,7 @@ begin end; end; - if CurrentContexts=nil then begin + if CurrentIdentifierContexts=nil then begin // create default AddCollectionContext(Self,CursorNode); end; @@ -2374,13 +2343,13 @@ begin Result:=true; finally if Result then begin - CodeContexts:=CurrentContexts; - CurrentContexts:=nil; + CodeContexts:=CurrentIdentifierContexts; + CurrentIdentifierContexts:=nil; end else begin - FreeAndNil(CurrentContexts); + FreeAndNil(CurrentIdentifierContexts); end; - FreeListOfPFindContext(ClassAndAncestors); - FreeAndNil(FoundPublicProperties); + FreeListOfPFindContext(FICTClassAndAncestors); + FreeAndNil(FIDCTFoundPublicProperties); Params.Free; ClearIgnoreErrorAfter; DeactivateGlobalWriteLock; @@ -2437,8 +2406,8 @@ begin InitFoundMethods; FindIdentifierInContext(Params); - if FoundMethods<>nil then begin - AVLNode:=FoundMethods.FindLowest; + if FIDTFoundMethods<>nil then begin + AVLNode:=FIDTFoundMethods.FindLowest; while AVLNode<>nil do begin NodeExt:=TCodeTreeNodeExtension(AVLNode.Data); ANode:=NodeExt.Node; @@ -2454,7 +2423,7 @@ begin raise Exception.Create('TIdentCompletionTool.FindAbstractMethods inconsistency'); AddCodePosition(ListOfPCodeXYPosition,ProcXYPos); end; - AVLNode:=FoundMethods.FindSuccessor(AVLNode); + AVLNode:=FIDTFoundMethods.FindSuccessor(AVLNode); end; end; @@ -2565,28 +2534,28 @@ var m: PtrUint; begin inherited CalcMemSize(Stats); - if ClassAndAncestors<>nil then + if FICTClassAndAncestors<>nil then Stats.Add('TIdentCompletionTool.ClassAndAncestors', - ClassAndAncestors.Count*(SizeOf(TAVLTreeNode)+SizeOf(TCodeXYPosition))); - if FoundPublicProperties<>nil then + FICTClassAndAncestors.Count*(SizeOf(TAVLTreeNode)+SizeOf(TCodeXYPosition))); + if FIDCTFoundPublicProperties<>nil then Stats.Add('TIdentCompletionTool.FoundPublicProperties', - FoundPublicProperties.Count*SizeOf(TAVLTreeNode)); - if FoundMethods<>nil then begin - m:=PtrUint(FoundMethods.Count)*SizeOf(TAVLTreeNode); - Node:=FoundMethods.FindLowest; + FIDCTFoundPublicProperties.Count*SizeOf(TAVLTreeNode)); + if FIDTFoundMethods<>nil then begin + m:=PtrUint(FIDTFoundMethods.Count)*SizeOf(TAVLTreeNode); + Node:=FIDTFoundMethods.FindLowest; while Node<>nil do begin Ext:=TCodeTreeNodeExtension(Node.Data); inc(m,Ext.CalcMemSize); - Node:=FoundMethods.FindSuccessor(Node); + Node:=FIDTFoundMethods.FindSuccessor(Node); end; STats.Add('TIdentCompletionTool.FoundMethods',m); end; if CurrentIdentifierList<>nil then Stats.Add('TIdentCompletionTool.CurrentIdentifierList', CurrentIdentifierList.CalcMemSize); - if CurrentContexts<>nil then + if CurrentIdentifierContexts<>nil then Stats.Add('TIdentCompletionTool.CurrentContexts', - CurrentContexts.CalcMemSize); + CurrentIdentifierContexts.CalcMemSize); end; { TIdentifierListItem } diff --git a/components/codetools/pascalparsertool.pas b/components/codetools/pascalparsertool.pas index 5904f32224..8299bbd55b 100644 --- a/components/codetools/pascalparsertool.pas +++ b/components/codetools/pascalparsertool.pas @@ -746,7 +746,7 @@ begin then RaiseClassKeyWordExpected; ReadNextAtom; - // parse modifiers + // parse modifiers : if CurPos.Flag=cafWord then begin if UpAtomIs('SEALED') then begin while UpAtomIs('SEALED') do begin diff --git a/components/synedit/test/testbase.pas b/components/synedit/test/testbase.pas index b6aa5c356e..dddd71517e 100644 --- a/components/synedit/test/testbase.pas +++ b/components/synedit/test/testbase.pas @@ -22,6 +22,7 @@ type procedure TestSetSelText(Value: String; PasteMode: TSynSelectionMode = smNormal); property ViewedTextBuffer; property TextBuffer; + property TextView; // foldedview end; { TTestBase } @@ -84,6 +85,10 @@ type procedure TestIsCaret(Name: String; X, Y: Integer); // logical caret procedure TestIsCaretPhys(Name: String; X, Y: Integer); + procedure TestCompareString(Name, Expect, Value: String; DbgInfo: String = ''); + procedure TestCompareString(Name: String; Expect, Value: Array of String; DbgInfo: String = ''); + procedure TestCompareString(Name, Expect: String; Value: Array of String; DbgInfo: String = ''); + procedure TestCompareString(Name: String; Expect: Array of String; Value: String; DbgInfo: String = ''); // exclude trimspaces, as seen by other objects procedure TestIsText(Name, Text: String; FullText: Boolean = False); procedure TestIsText(Name: String; Lines: Array of String); @@ -95,9 +100,20 @@ type end; + function MyDbg(t: String): String; implementation +function MyDbg(t: String): String; +begin + Result := ''; + while(pos(LineEnding, t) > 0) do begin + Result := Result + '"' + copy(t, 1, pos(LineEnding, t)-1) + '" Len='+IntTostr(pos(LineEnding, t)-1) + DbgStr(copy(t, 1, pos(LineEnding, t)-1)) + LineEnding; + system.Delete(t, 1, pos(LineEnding, t)-1+length(LineEnding)); + end; + Result := Result + '"' + t + '" Len='+IntTostr(length(t)) + DbgStr(t); +end; + { TTestSynEdit } procedure TTestSynEdit.TestKeyPress(Key: Word; Shift: TShiftState); @@ -179,46 +195,63 @@ begin Format('X/Y=(%d, %d)', [SynEdit.CaretXY.X, SynEdit.CaretXY.Y])); end; -procedure TTestBase.TestIsText(Name, Text: String; FullText: Boolean = False); +procedure TTestBase.TestCompareString(Name, Expect, Value: String; DbgInfo: String); var i, j, x, y: Integer; s: String; - function MyDbg(t: String): String; - begin - Result := ''; - while(pos(LineEnding, t) > 0) do begin - Result := Result + '"' + copy(t, 1, pos(LineEnding, t)-1) + '" Len='+IntTostr(pos(LineEnding, t)-1) + DbgStr(copy(t, 1, pos(LineEnding, t)-1)) + LineEnding; - system.Delete(t, 1, pos(LineEnding, t)-1+length(LineEnding)); - end; - Result := Result + '"' + t + '" Len='+IntTostr(length(t)) + DbgStr(t); +begin + if Value = Expect then exit; + + i := 1; j := 1; x:= 1; y:= 1; + while i <= Min(length(Value), length(Expect)) do begin + if Value[i] <> Expect[i] then break; + if copy(Expect, i, length(LineEnding)) = LineEnding then begin + inc(y); + x := 1; + j := i + length(lineEnding); + inc(i, length(LineEnding)); + end + else + inc(i); end; + + Debugln([DbgInfo,' - Failed at x/y=(',x,', ',y,') Expected: ',LineEnding, MyDbg(Expect), LineEnding, + 'Got: ',LineEnding, MyDbg(Value), LineEnding ]); + TestFail(Name, Format('IsText - Failed at x/y=(%d, %d)%sExpected: "%s"...%sGot: "%s"%s%s ', + [x, y, LineEnding, + DbgStr(copy(Expect,j, i-j+5)), LineEnding, + DbgStr(copy(Value,j, i-j+5)), LineEnding, LineEnding]), + '"'+DbgStr(Expect)+'"', '"'+DbgStr(Value)+'"'); +end; + +procedure TTestBase.TestCompareString(Name: String; Expect, Value: array of String; + DbgInfo: String); +begin + TestCompareString(Name, LinesToText(Expect), LinesToText(Value), DbgInfo); +end; + +procedure TTestBase.TestCompareString(Name, Expect: String; Value: array of String; + DbgInfo: String); +begin + TestCompareString(Name, Expect, LinesToText(Value), DbgInfo); +end; + +procedure TTestBase.TestCompareString(Name: String; Expect: array of String; Value: String; + DbgInfo: String); +begin + TestCompareString(Name, LinesToText(Expect), Value, DbgInfo); +end; + +procedure TTestBase.TestIsText(Name, Text: String; FullText: Boolean = False); +var + s: String; begin if FullText then s := SynEdit.TestFullText else s := SynEdit.Text; - if (s <> Text) then begin - i := 1; j := 1; x:= 1; y:= 1; - while i <= Min(length(s), length(Text)) do begin - if s[i] <> Text[i] then break; - if copy(Text, i, length(LineEnding)) = LineEnding then begin - inc(y); - x := 1; - j := i + length(lineEnding); - inc(i, length(LineEnding)); - end - else - inc(i); - end; - Debugln(['IsText - Failed at x/y=(',x,', ',y,') Expected: ',LineEnding, MyDbg(Text), LineEnding, - 'Got: ',LineEnding, MyDbg(s), LineEnding ]); - TestFail(Name, Format('IsText - Failed at x/y=(%d, %d)%sExpected: "%s"...%sGot: "%s"%s%s ', - [x, y, LineEnding, - DbgStr(copy(Text,j, i-j+5)), LineEnding, - DbgStr(copy(s,j, i-j+5)), LineEnding, LineEnding]), - '"'+DbgStr(Text)+'"', '"'+DbgStr(s)+'"'); - end; + TestCompareString(Name, Text, s, 'IsText'); end; procedure TTestBase.TestIsText(Name: String; Lines: array of String); @@ -486,6 +519,7 @@ end; procedure TTestBase.PopBaseName; begin + if length(FBaseTestNames) = 0 then exit; SetLength(FBaseTestNames, length(FBaseTestNames) - 1); FBaseTestName := LinesToText(FBaseTestNames, ' '); end; diff --git a/ide/basebuildmanager.pas b/ide/basebuildmanager.pas index a98a0bee01..0957214c1a 100644 --- a/ide/basebuildmanager.pas +++ b/ide/basebuildmanager.pas @@ -40,9 +40,9 @@ type { TBaseBuildManager } - TBaseBuildManager = class + TBaseBuildManager = class(TComponent) public - constructor Create; + constructor Create(AOwner: TComponent); override; destructor Destroy; override; function GetTargetOS(UseCache: boolean): string; virtual; abstract; @@ -80,10 +80,10 @@ implementation { TBaseBuildManager } -constructor TBaseBuildManager.Create; +constructor TBaseBuildManager.Create(AOwner: TComponent); begin BuildBoss:=Self; - inherited Create; + inherited Create(AOwner); end; destructor TBaseBuildManager.Destroy; diff --git a/ide/buildmanager.pas b/ide/buildmanager.pas index 824762b1bf..9cc63ea04c 100644 --- a/ide/buildmanager.pas +++ b/ide/buildmanager.pas @@ -38,6 +38,7 @@ uses LConvEncoding, InterfaceBase, LCLProc, Dialogs, FileUtil, Forms, Controls, // codetools ExprEval, BasicCodeTools, CodeToolManager, DefineTemplates, CodeCache, + Laz_XMLCfg, CodeToolsStructs, // IDEIntf SrcEditorIntf, ProjectIntf, MacroIntf, IDEDialogs, IDEExternToolIntf, LazIDEIntf, @@ -54,6 +55,7 @@ type TBuildManager = class(TBaseBuildManager) private CurrentParsedCompilerOption: TParsedCompilerOptions; + FUnitSetCache: TFPCUnitSetCache; FScanningCompilerDisabled: boolean; function OnSubstituteCompilerOption(Options: TParsedCompilerOptions; const UnparsedValue: string; @@ -106,15 +108,16 @@ type procedure OnCmdLineCreate(var CmdLine: string; var Abort: boolean); function OnRunCompilerWithOptions(ExtTool: TIDEExternalToolOptions; CompOptions: TBaseCompilerOptions): TModalResult; + procedure SetUnitSetCache(const AValue: TFPCUnitSetCache); protected OverrideTargetOS: string; OverrideTargetCPU: string; OverrideLCLWidgetType: string; + FUnitSetChangeStamp: integer; + procedure Notification(AComponent: TComponent; Operation: TOperation); + override; public - CurDefinesCompilerFilename: String; - CurDefinesCompilerOptions: String; - - constructor Create; + constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure SetupTransferMacros; procedure SetupCompilerInterface; @@ -134,10 +137,13 @@ type function IsTestUnitFilename(const AFilename: string): boolean; override; function GetTargetUnitFilename(AnUnitInfo: TUnitInfo): string; override; - procedure GetFPCCompilerParamsForEnvironmentTest(out Params: string); - procedure RescanCompilerDefines(ResetBuildTarget, OnlyIfCompilerChanged: boolean); + procedure UpdateEnglishErrorMsgFilename; + procedure RescanCompilerDefines(ResetBuildTarget, ClearCaches: boolean); property ScanningCompilerDisabled: boolean read FScanningCompilerDisabled write FScanningCompilerDisabled; + procedure LoadFPCDefinesCaches; + procedure SaveFPCDefinesCaches; + property UnitSetCache: TFPCUnitSetCache read FUnitSetCache write SetUnitSetCache; function CheckAmbiguousSources(const AFilename: string; Compiling: boolean): TModalResult; override; @@ -207,10 +213,10 @@ begin GlobalMacroList.SubstituteStr(Result,CompilerOptionMacroNormal); end; -constructor TBuildManager.Create; +constructor TBuildManager.Create(AOwner: TComponent); begin MainBuildBoss:=Self; - inherited Create; + inherited Create(AOwner); OnBackupFileInteractive:=@BackupFile; RunCompilerWithOptions:=@OnRunCompilerWithOptions; @@ -322,6 +328,7 @@ begin Result:=''; if (Result='') or (Result='default') then Result:=GetDefaultTargetOS; + Result:=LowerCase(Result); end; function TBuildManager.GetTargetCPU(UseCache: boolean): string; @@ -335,6 +342,7 @@ begin Result:=''; if (Result='') or (Result='default') then Result:=GetDefaultTargetCPU; + Result:=LowerCase(Result); end; function TBuildManager.GetLCLWidgetType(UseCache: boolean): string; @@ -486,34 +494,53 @@ begin Result:=AnUnitInfo.Filename; end; -procedure TBuildManager.GetFPCCompilerParamsForEnvironmentTest(out - Params: string); -var - CurTargetOS: string; - CurTargetCPU: string; +procedure TBuildManager.UpdateEnglishErrorMsgFilename; begin - Params:=''; - CurTargetOS:=GetTargetOS(false); - if CurTargetOS<>'' then - Params:=AddCmdLineParameter(Params,'-T'+CurTargetOS); - CurTargetCPU:=GetTargetCPU(false); - if CurTargetCPU<>'' then - Params:=AddCmdLineParameter(Params,'-P'+CurTargetCPU); + if EnvironmentOptions.LazarusDirectory<>'' then begin + CodeToolBoss.DefinePool.EnglishErrorMsgFilename:= + AppendPathDelim(EnvironmentOptions.LazarusDirectory)+ + SetDirSeparators('components/codetools/fpc.errore.msg'); + CodeToolBoss.FPCDefinesCache.ExtraOptions:= + '-Fr'+CodeToolBoss.DefinePool.EnglishErrorMsgFilename; + end; end; procedure TBuildManager.RescanCompilerDefines(ResetBuildTarget, - OnlyIfCompilerChanged: boolean); + ClearCaches: boolean); var - CompilerTemplate, FPCSrcTemplate: TDefineTemplate; - CompilerUnitSearchPath, CompilerUnitLinks: string; - CurOptions: String; - TargetOS, TargetProcessor: string; - UnitLinksValid: boolean; - i: Integer; + TargetOS, TargetCPU: string; + CompilerFilename: String; + FPCSrcDir: string; + ADefTempl: TDefineTemplate; + + procedure AddTemplate(ADefTempl: TDefineTemplate; AddToPool: boolean; + const ErrorMsg: string); + begin + if ADefTempl = nil then + begin + DebugLn(''); + DebugLn(ErrorMsg); + end else + begin + if AddToPool then + CodeToolBoss.DefinePool.Add(ADefTempl.CreateCopy(false,true,true)); + CodeToolBoss.DefineTree.ReplaceRootSameName(ADefTempl); + end; + end; function FoundSystemPPU: boolean; + var + ConfigCache: TFPCTargetConfigCache; + AFilename: string; begin - Result:=System.Pos('system ',CompilerUnitLinks)>0; + Result:=false; + ConfigCache:=UnitSetCache.GetConfigCache(false); + if ConfigCache=nil then exit; + if ConfigCache.Units=nil then exit; + AFilename:=ConfigCache.Units['system']; + if AFilename='' then exit; + if CompareFileExt(AFilename,'.ppu')<>0 then exit; + Result:=true; end; begin @@ -521,99 +548,134 @@ begin if ResetBuildTarget then SetBuildTarget('','','',true); - GetFPCCompilerParamsForEnvironmentTest(CurOptions); + // start the compiler and ask for his settings + // provide an english message file + UpdateEnglishErrorMsgFilename; + + // use current TargetOS, TargetCPU, compilerfilename and FPC source dir + TargetOS:=GetTargetOS(true); + TargetCPU:=GetTargetCPU(true); + CompilerFilename:=EnvironmentOptions.CompilerFilename; + FPCSrcDir:=EnvironmentOptions.GetFPCSourceDirectory; + {$IFDEF VerboseFPCSrcScan} - debugln(['TMainIDE.RescanCompilerDefines A ',CurOptions, - ' OnlyIfCompilerChanged=',OnlyIfCompilerChanged, - ' Valid=',InputHistories.FPCConfigCache.Valid(true), - ' ID=',InputHistories.FPCConfigCache.FindItem(CurOptions), - ' CurDefinesCompilerFilename=',CurDefinesCompilerFilename, - ' EnvCompilerFilename=',EnvironmentOptions.CompilerFilename, - ' CurDefinesCompilerOptions="',CurDefinesCompilerOptions,'"', - ' CurOptions="',CurOptions,'"', + debugln(['TMainIDE.RescanCompilerDefines A ', + ' ClearCaches=',ClearCaches, + ' CompilerFilename=',CompilerFilename, + ' TargetOS=',TargetOS, + ' TargetCPU=',TargetCPU, + ' EnvFPCSrcDir=',EnvironmentOptions.FPCSourceDirectory, + ' FPCSrcDir=',FPCSrcDir, '']); {$ENDIF} - // rescan compiler defines - // ask the compiler for its settings - if OnlyIfCompilerChanged - and (CurDefinesCompilerFilename=EnvironmentOptions.CompilerFilename) - and (CurDefinesCompilerOptions=CurOptions) then + + if ClearCaches then begin + { $IFDEF VerboseFPCSrcScan} + debugln(['TBuildManager.RescanCompilerDefines clear caches']); + { $ENDIF} + CodeToolBoss.FPCDefinesCache.ConfigCaches.Clear; + CodeToolBoss.FPCDefinesCache.SourceCaches.Clear; + end; + + UnitSetCache:=CodeToolBoss.FPCDefinesCache.FindUnitSet( + CompilerFilename,TargetOS,TargetCPU,'',FPCSrcDir,true); + + UnitSetCache.Init; + if FUnitSetChangeStamp=UnitSetCache.ChangeStamp then begin + {$IFDEF VerboseFPCSrcScan} + debugln(['TBuildManager.RescanCompilerDefines nothing changed']); + {$ENDIF} exit; + end; + FUnitSetChangeStamp:=UnitSetCache.ChangeStamp; + {$IFDEF VerboseFPCSrcScan} - debugln('TMainIDE.RescanCompilerDefines B rebuilding FPC templates CurOptions="',CurOptions,'"'); + debugln(['TBuildManager.RescanCompilerDefines UnitSet changed => rebuilding defines', + ' ClearCaches=',ClearCaches, + ' CompilerFilename=',CompilerFilename, + ' TargetOS=',TargetOS, + ' TargetCPU=',TargetCPU, + ' EnvFPCSrcDir=',EnvironmentOptions.FPCSourceDirectory, + ' FPCSrcDir=',FPCSrcDir, + '']); {$ENDIF} - SetupInputHistories; - CompilerTemplate:=CodeToolBoss.DefinePool.CreateFPCTemplate( - EnvironmentOptions.CompilerFilename,CurOptions, - CreateCompilerTestPascalFilename,CompilerUnitSearchPath, - TargetOS,TargetProcessor,CodeToolsOpts); - //DebugLn('TMainIDE.RescanCompilerDefines CompilerUnitSearchPath="',CompilerUnitSearchPath,'"'); - if CompilerTemplate<>nil then begin - CurDefinesCompilerFilename:=EnvironmentOptions.CompilerFilename; - CurDefinesCompilerOptions:=CurOptions; - CodeToolBoss.DefineTree.ReplaceRootSameNameAddFirst(CompilerTemplate); - // the compiler version was updated, update the FPCSrcDir - CodeToolBoss.GlobalValues.Variables[ExternalMacroStart+'FPCSrcDir']:= - EnvironmentOptions.GetFPCSourceDirectory; - UnitLinksValid:=OnlyIfCompilerChanged - and InputHistories.FPCConfigCache.Valid(true); - if UnitLinksValid then begin - i:=InputHistories.FPCConfigCache.FindItem(CurOptions); - if i<0 then begin - UnitLinksValid:=false; - end - else if CompareFilenames(InputHistories.FPCConfigCache.Items[i].FPCSrcDir, - EnvironmentOptions.GetFPCSourceDirectory)<>0 - then - UnitLinksValid:=false; - end; - {$IFDEF VerboseFPCSrcScan} - debugln(['TMainIDE.RescanCompilerDefines B rescanning FPC sources UnitLinksValid=',UnitLinksValid]); - {$ENDIF} + // save caches + SaveFPCDefinesCaches; - // create compiler macros to simulate the Makefiles of the FPC sources - CompilerUnitLinks:=''; - if UnitLinksValid then - CompilerUnitLinks:=InputHistories.FPCConfigCache.GetUnitLinks(CurOptions); - if not FoundSystemPPU then begin - UnitLinksValid:=false; - end; + // rebuild the define templates + // create template for FPC settings + ADefTempl:=CreateFPCTemplate(UnitSetCache,nil); + AddTemplate(ADefTempl,false, + 'NOTE: Could not create Define Template for Free Pascal Compiler'); + // create template for FPC source directory + ADefTempl:=CreateFPCSrcTemplate(UnitSetCache,nil); + AddTemplate(ADefTempl,false,lisNOTECouldNotCreateDefineTemplateForFreePascal); - FPCSrcTemplate:=CreateFPCSourceTemplate( - CodeToolBoss.GlobalValues.Variables[ExternalMacroStart+'FPCSrcDir'], - CompilerUnitSearchPath, - CodeToolBoss.GetCompiledSrcExtForDirectory(''), - TargetOS,TargetProcessor, - UnitLinksValid, CompilerUnitLinks, CodeToolsOpts); - {$IFDEF VerboseFPCSrcScan} - debugln('TMainIDE.RescanCompilerDefines C UnitLinks=',copy(CompilerUnitLinks,1,100)); - {$ENDIF} - if not FoundSystemPPU then begin - IDEMessageDialog(lisCCOErrorCaption, - Format(lisTheProjectUsesTargetOSAndCPUTheSystemPpuForThisTar, [ - TargetOS, TargetProcessor, #13, #13]), - mtError,[mbOk]); - end; + // create compiler macros for the lazarus sources + if CodeToolBoss.DefineTree.FindDefineTemplateByName(StdDefTemplLazarusSrcDir,true + )=nil + then begin + ADefTempl:=CreateLazarusSourceTemplate( + '$('+ExternalMacroStart+'LazarusDir)', + '$('+ExternalMacroStart+'LCLWidgetType)', + MiscellaneousOptions.BuildLazOpts.ExtraOptions,nil); + AddTemplate(ADefTempl,true, + lisNOTECouldNotCreateDefineTemplateForLazarusSources); + end; - if FPCSrcTemplate<>nil then begin - CodeToolBoss.DefineTree.RemoveRootDefineTemplateByName( - FPCSrcTemplate.Name); - FPCSrcTemplate.InsertBehind(CompilerTemplate); - CodeToolBoss.DefineTree.ClearCache; - // save unitlinks - InputHistories.SetLastFPCUnitLinks(EnvironmentOptions.CompilerFilename, - CurOptions,CompilerUnitSearchPath, - EnvironmentOptions.GetFPCSourceDirectory, - CompilerUnitLinks); - InputHistories.Save; - end else begin - IDEMessageDialog(lisFPCSourceDirectoryError, - lisPleaseCheckTheFPCSourceDirectory,mtError,[mbOk]); + CodeToolBoss.DefineTree.ClearCache; + + if not FoundSystemPPU then begin + IDEMessageDialog(lisCCOErrorCaption, + Format(lisTheProjectUsesTargetOSAndCPUTheSystemPpuForThisTar, [ + TargetOS, TargetCPU, #13, #13]), + mtError,[mbOk]); + end; +end; + +procedure TBuildManager.LoadFPCDefinesCaches; +var + aFilename: String; + XMLConfig: TXMLConfig; +begin + aFilename:=AppendPathDelim(GetPrimaryConfigPath)+'fpcdefines.xml'; + CopySecondaryConfigFile(ExtractFilename(aFilename)); + if not FileExistsUTF8(aFilename) then exit; + try + XMLConfig:=TXMLConfig.Create(aFilename); + try + CodeToolBoss.FPCDefinesCache.LoadFromXMLConfig(XMLConfig,''); + finally + XMLConfig.Free; + end; + except + on E: Exception do begin + debugln(['LoadFPCDefinesCaches Error loadinf file '+aFilename+':'+E.Message]); + end; + end; +end; + +procedure TBuildManager.SaveFPCDefinesCaches; +var + aFilename: String; + XMLConfig: TXMLConfig; +begin + aFilename:=AppendPathDelim(GetPrimaryConfigPath)+'fpcdefines.xml'; + if FileExistsCached(aFilename) + and (not CodeToolBoss.FPCDefinesCache.NeedsSave) then + exit; + try + XMLConfig:=TXMLConfig.CreateClean(aFilename); + try + CodeToolBoss.FPCDefinesCache.SaveToXMLConfig(XMLConfig,''); + finally + XMLConfig.Free; + end; + except + on E: Exception do begin + debugln(['LoadFPCDefinesCaches Error loadinf file '+aFilename+':'+E.Message]); end; - end else begin - IDEMessageDialog(lisCompilerError,lisPleaseCheckTheCompilerName,mtError, - [mbOk]); end; end; @@ -1258,14 +1320,31 @@ function TBuildManager.MacroFuncFPCVer(const Param: string; const Data: PtrInt; var Abort: boolean): string; var FPCVersion, FPCRelease, FPCPatch: integer; - Def: TDefineTemplate; + TargetOS: String; + TargetCPU: String; + CompilerFilename: String; + ConfigCache: TFPCTargetConfigCache; begin - Result:={$I %FPCVERSION%}; + Result:={$I %FPCVERSION%}; // Version.Release.Patch if CodeToolBoss<>nil then begin - Def:=CodeToolBoss.DefineTree.FindDefineTemplateByName(StdDefTemplFPC,true); - CodeToolBoss.DefinePool.GetFPCVerFromFPCTemplate(Def,FPCVersion,FPCRelease,FPCPatch); - if FPCVersion<>0 then - Result:=IntToStr(FPCVersion)+'.'+IntToStr(FPCRelease)+'.'+IntToStr(FPCPatch); + // fetch the FPC version from the current compiler + // Not from the fpc.exe, but from the real compiler + CompilerFilename:=EnvironmentOptions.CompilerFilename; + if CompilerFilename='' then exit; + TargetOS:=GetTargetOS(true); + TargetCPU:=GetTargetCPU(true); + ConfigCache:=CodeToolBoss.FPCDefinesCache.ConfigCaches.Find( + CompilerFilename,'',TargetOS,TargetCPU,true); + if ConfigCache=nil then exit; + if (ConfigCache.CompilerDate=0) and ConfigCache.NeedsUpdate then begin + // ask compiler + if not ConfigCache.Update(CodeToolBoss.FPCDefinesCache.TestFilename, + CodeToolBoss.FPCDefinesCache.ExtraOptions,nil) + then + exit; + end; + ConfigCache.GetFPCVer(FPCVersion,FPCRelease,FPCPatch); + Result:=IntToStr(FPCVersion)+'.'+IntToStr(FPCRelease)+'.'+IntToStr(FPCPatch); end; end; @@ -1444,6 +1523,26 @@ begin LazarusIDE.DoCheckFilesOnDisk; end; +procedure TBuildManager.SetUnitSetCache(const AValue: TFPCUnitSetCache); +begin + if FUnitSetCache=AValue then exit; + FUnitSetCache:=AValue; + if UnitSetCache<>nil then begin + FreeNotification(UnitSetCache); + FUnitSetChangeStamp:=UnitSetCache.GetInvalidChangeStamp; + end; +end; + +procedure TBuildManager.Notification(AComponent: TComponent; + Operation: TOperation); +begin + inherited Notification(AComponent, Operation); + if Operation=opRemove then begin + if FUnitSetCache=AComponent then + FUnitSetCache:=nil; + end; +end; + procedure TBuildManager.SetBuildTarget(const TargetOS, TargetCPU, LCLWidgetType: string; DoNotScanFPCSrc: boolean); var @@ -1459,9 +1558,9 @@ begin OldTargetOS:=GetTargetOS(true); OldTargetCPU:=GetTargetCPU(true); OldLCLWidgetType:=GetLCLWidgetType(true); - OverrideTargetOS:=TargetOS; - OverrideTargetCPU:=TargetCPU; - OverrideLCLWidgetType:=LCLWidgetType; + OverrideTargetOS:=lowercase(TargetOS); + OverrideTargetCPU:=lowercase(TargetCPU); + OverrideLCLWidgetType:=lowercase(LCLWidgetType); NewTargetOS:=GetTargetOS(false); NewTargetCPU:=GetTargetCPU(false); NewLCLWidgetType:=GetLCLWidgetType(false); @@ -1476,7 +1575,7 @@ begin if LCLTargetChanged then CodeToolBoss.SetGlobalValue(ExternalMacroStart+'LCLWidgetType',NewLCLWidgetType); if FPCTargetChanged and (not DoNotScanFPCSrc) then - RescanCompilerDefines(false,true); + RescanCompilerDefines(false,false); if FPCTargetChanged or LCLTargetChanged then begin IncreaseCompilerParseStamp; diff --git a/ide/codebrowser.pas b/ide/codebrowser.pas index 5fd95d0508..2cd8560fe3 100644 --- a/ide/codebrowser.pas +++ b/ide/codebrowser.pas @@ -48,8 +48,8 @@ uses Menus, // codetools CodeAtom, BasicCodeTools, DefineTemplates, CodeTree, CodeCache, - CodeToolManager, PascalParserTool, LinkScanner, FileProcs, CodeIndex, - StdCodeTools, SourceLog, + CodeToolsStructs, CodeToolManager, PascalParserTool, LinkScanner, FileProcs, + CodeIndex, StdCodeTools, SourceLog, // IDEIntf IDEWindowIntf, SrcEditorIntf, IDEMsgIntf, IDEDialogs, LazConfigStorage, PackageIntf, TextTools, IDECommands, LazIDEIntf, @@ -1323,35 +1323,36 @@ var procedure AddFilesOfPackageFCL; var LazDir: String; - UnitLinks: String; - SpacePos: LongInt; + UnitSetID: string; + UnitSetChanged: Boolean; + UnitSet: TFPCUnitSetCache; Filename: String; - StartPos: Integer; - EndPos: LongInt; + ConfigCache: TFPCTargetConfigCache; + Node: TAVLTreeNode; + Item: PStringToStringTreeItem; begin - // use unitlinks of the lazarus source directory + // use unitset of the lazarus source directory LazDir:=AppendPathDelim(EnvironmentOptions.LazarusDirectory); if (LazDir='') or (not FilenameIsAbsolute(LazDir)) then exit; - UnitLinks:=CodeToolBoss.GetUnitLinksForDirectory(LazDir); - StartPos:=1; - while StartPos<=length(UnitLinks) do begin - EndPos:=StartPos; - while (EndPos<=length(UnitLinks)) - and (not (UnitLinks[EndPos] in [#10,#13])) do - inc(EndPos); - if EndPos>StartPos then begin - SpacePos:=StartPos; - while (SpacePos<=length(UnitLinks)) and (UnitLinks[SpacePos]<>' ') do - inc(SpacePos); - if (SpacePos>StartPos) and (SpacePos<EndPos) then begin - Filename:=copy(UnitLinks,SpacePos+1,EndPos-SpacePos-1); - AddFile(Filename,true); - end; + UnitSetID:=CodeToolBoss.GetUnitSetIDForDirectory(LazDir); + if UnitSetID='' then exit; + UnitSetChanged:=false; + UnitSet:=CodeToolBoss.FPCDefinesCache.FindUnitSetWithID(UnitSetID, + UnitSetChanged,false); + if UnitSet=nil then exit; + ConfigCache:=UnitSet.GetConfigCache(false); + if (ConfigCache=nil) or (ConfigCache.Units=nil) then exit; + Node:=ConfigCache.Units.Tree.FindLowest; + while Node<>nil do begin + Item:=PStringToStringTreeItem(Node.Data); + Filename:=Item^.Value; + if (CompareFileExt(Filename,'ppu',false)=0) then begin + // search source in fpc sources + Filename:=UnitSet.GetUnitSrcFile(ExtractFileNameOnly(Filename)); end; - StartPos:=EndPos; - while (StartPos<=length(UnitLinks)) - and (UnitLinks[StartPos] in [#10,#13]) do - inc(StartPos); + if FilenameIsPascalUnit(Filename) then + AddFile(Filename,false); + Node:=ConfigCache.Units.Tree.FindSuccessor(Node); end; end; diff --git a/ide/codetoolsdefines.pas b/ide/codetoolsdefines.pas index f2c2e363a1..30e0f05d95 100644 --- a/ide/codetoolsdefines.pas +++ b/ide/codetoolsdefines.pas @@ -568,10 +568,11 @@ end; procedure TCodeToolsDefinesEditor.InsertFPCProjectDefinesTemplateMenuItemClick( Sender: TObject); var InputFileDlg: TInputFileDialog; - UnitSearchPath, UnitLinkList, DefaultFPCSrcDir, DefaultCompiler, + DefaultFPCSrcDir, DefaultCompiler, CompilerPath, FPCSrcDir: string; - DirTemplate, FPCTemplate, FPCSrcTemplate: TDefineTemplate; + DirTemplate, FPCTemplate: TDefineTemplate; TargetOS, TargetProcessor: string; + UnitSetCache: TFPCUnitSetCache; begin InputFileDlg:=GetInputFileDialog; InputFileDlg.Macros:=Macros; @@ -579,9 +580,7 @@ begin DefaultFPCSrcDir:='$(FPCSrcDir)'; DefaultCompiler:='$(CompPath)'; - UnitSearchPath:=''; - UnitLinkList:=''; - + BeginUpdate; Caption:=lisCodeToolsDefsCreateFPCMacrosAndPathsForAFPCProjectDirectory; @@ -607,31 +606,20 @@ begin EndUpdate; if ShowModal=mrCancel then exit; + FPCSrcDir:=FileNames[2]; + if Macros<>nil then Macros.SubstituteStr(FPCSrcDir); + if FPCSrcDir='' then FPCSrcDir:=DefaultFPCSrcDir; + DebugLn(' FPCSrcDir="',FPCSrcDir,'"'); + // ask the compiler for Macros CompilerPath:=FileNames[1]; if Macros<>nil then Macros.SubstituteStr(CompilerPath); DebugLn(' CompilerPath="',CompilerPath,'"'); TargetOS:=''; TargetProcessor:=''; - if (CompilerPath<>'') and (CompilerPath<>DefaultCompiler) then - FPCTemplate:=Boss.DefinePool.CreateFPCTemplate(CompilerPath,'', - CreateCompilerTestPascalFilename,UnitSearchPath, - TargetOS,TargetProcessor, - CodeToolsOpts) - else - FPCTemplate:=nil; - // create path defines - FPCSrcDir:=FileNames[2]; - if Macros<>nil then Macros.SubstituteStr(FPCSrcDir); - DebugLn(' FPCSrcDir="',FPCSrcDir,'"'); - if (FPCSrcDir<>'') and (FPCSrcDir<>DefaultFPCSrcDir) - and (UnitSearchPath<>'') then - FPCSrcTemplate:=CreateFPCSourceTemplate(FPCSrcDir, - UnitSearchPath, 'ppu', TargetOS, TargetProcessor, false, - UnitLinkList, CodeToolsOpts) - else - FPCSrcTemplate:=nil; + UnitSetCache:=Boss.FPCDefinesCache.FindUnitSet(CompilerPath, + TargetOS,TargetProcessor,'',FPCSrcDir,true); // create directory defines DirTemplate:=TDefineTemplate.Create('FPC Project ('+FileNames[0]+')', @@ -640,20 +628,13 @@ begin if (DefaultFPCSrcDir=Filenames[2]) and (DefaultCompiler=Filenames[1]) then begin // a normal fpc project -> nothing special needed - FPCTemplate.Free; - FPCSrcTemplate.Free; end else begin // a special fpc project -> create a world of its own DirTemplate.AddChild(TDefineTemplate.Create('Reset All', 'Reset all values','','',da_UndefineAll)); + FPCTemplate:=CreateFPCTemplate(UnitSetCache,CodeToolsOpts); if FPCTemplate<>nil then DirTemplate.AddChild(FPCTemplate); - if UnitLinkList<>'' then begin - DirTemplate.AddChild(TDefineTemplate.Create('FPC Unit Links', - 'Source filenames for standard FPC units', - ExternalMacroStart+'UnitLinks',UnitLinkList,da_DefineRecurse)); - end; - FPCSrcTemplate.Free; end; DirTemplate.SetDefineOwner(CodeToolsOpts,true); @@ -707,16 +688,15 @@ end; procedure TCodeToolsDefinesEditor.InsertFPCSourceDirDefinesTemplateMenuItemClick (Sender: TObject); var InputFileDlg: TInputFileDialog; - UnitSearchPath, UnitLinks, DefaultCompiler, CompilerPath, FPCSrcDir: string; + DefaultCompiler, CompilerPath, FPCSrcDir: string; TargetOS, TargetProcessor: string; - ResetAllTemplate, FPCSrcTemplate, FPCSrcDirTemplate, - FPCTemplate: TDefineTemplate; + FPCSrcTemplate: TDefineTemplate; + UnitSetCache: TFPCUnitSetCache; begin InputFileDlg:=GetInputFileDialog; InputFileDlg.Macros:=Macros; with InputFileDlg do begin DefaultCompiler:='$(CompPath)'; - UnitSearchPath:=''; BeginUpdate; Caption:=lisCodeToolsDefsCreateDefinesForFreePascalSVNSources; @@ -724,7 +704,7 @@ begin FileTitles[0]:=lisCodeToolsDefsFPCSVNSourceDirectory; FileDescs[0]:=lisCodeToolsDefsTheFreePascalSVNSourceDir; - FileNames[0]:='~/fpc_sources/2.1/fpc'; + FileNames[0]:='~/fpc_sources/2.4.1/fpc'; FileFlags[0]:=[iftDirectory,iftNotEmpty,iftMustExist]; FileTitles[1]:=lisCodeToolsDefscompilerPath; @@ -743,39 +723,24 @@ begin TargetOS:=''; TargetProcessor:=''; - FPCTemplate:=Boss.DefinePool.CreateFPCTemplate(CompilerPath,'', - CreateCompilerTestPascalFilename,UnitSearchPath, - TargetOS,TargetProcessor,CodeToolsOpts); - if FPCTemplate=nil then begin - DebugLn('ERROR: unable to get FPC Compiler Macros from "',CompilerPath,'"'); - exit; - end; - - // create FPC Source defines FPCSrcDir:=FileNames[0]; if Macros<>nil then Macros.SubstituteStr(FPCSrcDir); DebugLn(' FPCSrcDir="',FPCSrcDir,'"'); - FPCSrcTemplate:=CreateFPCSourceTemplate(FPCSrcDir, - UnitSearchPath, 'ppu', TargetOS, TargetProcessor, false, - UnitLinks, CodeToolsOpts); + + UnitSetCache:=Boss.FPCDefinesCache.FindUnitSet(CompilerPath, + TargetOS,TargetProcessor,'',FPCSrcDir,true); + // create FPC Source defines + FPCSrcTemplate:=CreateFPCSrcTemplate(UnitSetCache,CodeToolsOpts); if FPCSrcTemplate=nil then begin DebugLn('ERROR: unable to create FPC CVS Src defines for "',FPCSrcDir,'"'); - FPCTemplate.Free; exit; end; // create directory defines - FPCSrcDirTemplate:=FPCSrcTemplate.FirstChild.Next; - FPCSrcDirTemplate.UnBind; - FPCSrcTemplate.Free; - FPCSrcDirTemplate.Name:='FPC CVS Sources ('+FileNames[0]+')'; - ResetAllTemplate:=TDefineTemplate.Create('Reset All','Reset all values', - '','',da_UndefineAll); - ResetAllTemplate.InsertInFront(FPCSrcDirTemplate.FirstChild); - FPCTemplate.InsertBehind(ResetAllTemplate); + FPCSrcTemplate.Name:='FPC SVN Sources ('+FileNames[0]+')'; - FPCSrcDirTemplate.SetDefineOwner(CodeToolsOpts,true); - InsertTemplate(FPCSrcDirTemplate); + FPCSrcTemplate.SetDefineOwner(CodeToolsOpts,true); + InsertTemplate(FPCSrcTemplate); end; end; diff --git a/ide/codetoolsoptions.pas b/ide/codetoolsoptions.pas index 3baea73156..36b45e954e 100644 --- a/ide/codetoolsoptions.pas +++ b/ide/codetoolsoptions.pas @@ -590,7 +590,7 @@ begin ConfFileName:=SetDirSeparators( GetPrimaryConfigPath+'/'+DefaultCodeToolsOptsFile); CopySecondaryConfigFile(DefaultCodeToolsOptsFile); - if (not FileExistsUTF8(ConfFileName)) then begin + if (not FileExistsCached(ConfFileName)) then begin debugln(UTF8ToConsole(lisCompilerNOTECodetoolsConfigFileNotFoundUsingDefaults)); end; FFilename:=ConfFilename; diff --git a/ide/lazarusidestrconsts.pas b/ide/lazarusidestrconsts.pas index 6ff3e72b81..0a4bdfed5e 100644 --- a/ide/lazarusidestrconsts.pas +++ b/ide/lazarusidestrconsts.pas @@ -813,9 +813,7 @@ resourcestring lisProjectChanged = 'Project changed'; lisFPCSourceDirectoryError = 'FPC Source Directory error'; - lisPleaseCheckTheFPCSourceDirectory = 'Please check the freepascal source directory'; lisCompilerError = 'Compiler error'; - lisPleaseCheckTheCompilerName = 'Please check the compiler name'; lisAboutLazarus = 'About Lazarus'; lisVersion = 'Version'; lisVerToClipboard = 'Copy version information to clipboard'; diff --git a/ide/lazbuild.lpi b/ide/lazbuild.lpi index d0a09134ea..6916892d62 100644 --- a/ide/lazbuild.lpi +++ b/ide/lazbuild.lpi @@ -1,7 +1,7 @@ <?xml version="1.0"?> <CONFIG> <ProjectOptions> - <Version Value="7"/> + <Version Value="8"/> <General> <Flags> <LRSInOutputDirectory Value="False"/> diff --git a/ide/lazbuild.lpr b/ide/lazbuild.lpr index d39eefdeb2..b284eaadab 100644 --- a/ide/lazbuild.lpr +++ b/ide/lazbuild.lpr @@ -612,6 +612,8 @@ begin Project1.CompilerOptions.TargetCPU:=CPUOverride; if (Length(WidgetSetOverride) <> 0) then Project1.CompilerOptions.LCLWidgetType:=WidgetSetOverride; + MainBuildBoss.SetBuildTarget(Project1.CompilerOptions.TargetOS, + Project1.CompilerOptions.TargetCPU,Project1.CompilerOptions.LCLWidgetType); if not SkipDependencies then begin // compile required packages @@ -646,7 +648,6 @@ begin else CompilerFilename:=Project1.GetCompilerFilename; //DebugLn(['TMainIDE.DoBuildProject CompilerFilename="',CompilerFilename,'" CompilerPath="',Project1.CompilerOptions.CompilerPath,'"']); - CompilerParams:=Project1.CompilerOptions.MakeOptionsString(SrcFilename,nil,[]) +' '+PrepareCmdLineOption(SrcFilename); @@ -745,7 +746,7 @@ begin CreatePrimaryConfigPath; - MainBuildBoss:=TBuildManager.Create; + MainBuildBoss:=TBuildManager.Create(nil); MainBuildBoss.ScanningCompilerDisabled:=true; LoadEnvironmentOptions; LoadMiscellaneousOptions; diff --git a/ide/main.pp b/ide/main.pp index 3f23f69f31..d82efedca0 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -928,7 +928,6 @@ type // methods for codetools procedure InitCodeToolBoss; - procedure UpdateEnglishErrorMsgFilename; procedure ActivateCodeToolAbortableMode; function BeginCodeTools: boolean; override; function BeginCodeTool(var ActiveSrcEdit: TSourceEditor; @@ -1279,7 +1278,7 @@ begin TOutputFilterProcess := TProcessUTF8; {$ENDIF} - MainBuildBoss:=TBuildManager.Create; + MainBuildBoss:=TBuildManager.Create(nil); {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TMainIDE.Create BUILD MANAGER');{$ENDIF} // load options @@ -4371,7 +4370,7 @@ begin PkgBoss.TranslateResourceStrings; end; // set global variables - UpdateEnglishErrorMsgFilename; + MainBuildBoss.UpdateEnglishErrorMsgFilename; MacroValueChanged:=false; FPCSrcDirChanged:=false; FPCCompilerChanged:=OldCompilerFilename<>EnvironmentOptions.CompilerFilename; @@ -4380,8 +4379,9 @@ begin ChangeMacroValue('FPCSrcDir',EnvironmentOptions.FPCSourceDirectory); if MacroValueChanged then CodeToolBoss.DefineTree.ClearCache; + debugln(['TMainIDE.DoEnvironmentOptionsAfterWrite FPCCompilerChanged=',FPCCompilerChanged,' FPCSrcDirChanged=',FPCSrcDirChanged,' LazarusSrcDirChanged=',LazarusSrcDirChanged]); if FPCCompilerChanged or FPCSrcDirChanged then - MainBuildBoss.RescanCompilerDefines(true, false); + MainBuildBoss.RescanCompilerDefines(true,false); // update environment UpdateDesigners; @@ -4545,7 +4545,7 @@ begin begin TBaseCompilerOptions(Sender).Modified := True; IncreaseCompilerParseStamp; - MainBuildBoss.RescanCompilerDefines(True, True); + MainBuildBoss.RescanCompilerDefines(True, False); IncreaseCompilerParseStamp; UpdateHighlighters; // because of FPC/Delphi mode end; @@ -4574,7 +4574,7 @@ end; procedure TMainIDE.mnuEnvRescanFPCSrcDirClicked(Sender: TObject); begin - MainBuildBoss.RescanCompilerDefines(true,false); + MainBuildBoss.RescanCompilerDefines(false,true); end; procedure TMainIDE.SaveEnvironment; @@ -7586,7 +7586,7 @@ begin .BuildModeGraph:=DefaultBuildModeGraph; {$ENDIF} - MainBuildBoss.RescanCompilerDefines(true,true); + MainBuildBoss.RescanCompilerDefines(true,false); // load required packages PkgBoss.OpenProjectDependencies(Project1,true); @@ -9614,7 +9614,7 @@ begin PkgBoss.AddDefaultDependencies(Project1); // rebuild codetools defines - MainBuildBoss.RescanCompilerDefines(true,true); + MainBuildBoss.RescanCompilerDefines(true,false); // (i.e. remove old project specific things and create new) IncreaseCompilerParseStamp; @@ -12977,10 +12977,10 @@ begin if SearchInPath(StartUnitPath,AFilename,Result) then exit; // search unit in fpc source directory - Result:=CodeToolBoss.FindUnitInUnitLinks(BaseDir, - ExtractFilenameOnly(AFilename)); + Result:=CodeToolBoss.FindUnitInUnitSet(BaseDir, + ExtractFilenameOnly(AFilename)); {$IFDEF VerboseFindSourceFile} - debugln(['TMainIDE.FindSourceFile trying unit links Result=',Result]); + debugln(['TMainIDE.FindSourceFile tried unitset Result=',Result]); {$ENDIF} if Result<>'' then exit; end; @@ -13300,32 +13300,16 @@ end; procedure TMainIDE.InitCodeToolBoss; // initialize the CodeToolBoss, which is the frontend for the codetools. // - sets a basic set of compiler macros - - procedure AddTemplate(ADefTempl: TDefineTemplate; AddToPool: boolean; - const ErrorMsg: string); - begin - if ADefTempl = nil then - begin - DebugLn(''); - DebugLn(UTF8ToConsole(ErrorMsg)); - end else - begin - if AddToPool then - CodeToolBoss.DefinePool.Add(ADefTempl.CreateCopy(false,true,true)); - CodeToolBoss.DefineTree.Add(ADefTempl); - end; - end; - -var CompilerUnitSearchPath, CompilerUnitLinks: string; - ADefTempl: TDefineTemplate; +var AFilename: string; - UnitLinksChanged: boolean; - TargetOS, TargetProcessor: string; InteractiveSetup: boolean; begin InteractiveSetup:=true; OpenEditorsOnCodeToolChange:=false; + // load caches + MainBuildBoss.LoadFPCDefinesCaches; + CodeToolBoss.DefinePool.OnProgress:=@CodeToolBossProgress; CodeToolBoss.SourceCache.ExpirationTimeInDays:=365; CodeToolBoss.SourceCache.OnEncodeSaving:=@OnCodeBufferEncodeSaving; @@ -13341,101 +13325,54 @@ begin 'PROJECT',nil,@CTMacroFunctionProject); CodeToolsOpts.AssignTo(CodeToolBoss); - if (not FileExistsUTF8(EnvironmentOptions.CompilerFilename)) then begin + if (not FileExistsCached(EnvironmentOptions.CompilerFilename)) then begin DebugLn(''); - DebugLn('NOTE: Compiler Filename not set! (see Environment Options)'); + DebugLn('NOTE: Compiler filename not set! (see Environment / Options ... / Environment / Files)'); end; if (EnvironmentOptions.LazarusDirectory='') or not DirPathExists(EnvironmentOptions.LazarusDirectory) then begin DebugLn(''); DebugLn( - 'NOTE: Lazarus Source Directory not set! (see Environment Options)'); + 'NOTE: Lazarus source directory not set! (see Environment / Options ... / Environment / Files)'); end; - if (EnvironmentOptions.FPCSourceDirectory='') - or not DirPathExists(EnvironmentOptions.GetFPCSourceDirectory) then begin + if (EnvironmentOptions.FPCSourceDirectory='') then begin + // Note: the FPCSourceDirectory can contain the macro FPCVer, which depend + // on the compiler. Do not check if file exists here. DebugLn(''); - DebugLn('NOTE: FPC Source Directory not set! (see Environment Options)'); + DebugLn('NOTE: FPC source directory not set! (see Environment / Options ... / Environment / Files)'); end; - // set global variables + // create a test unit needed to get from the compiler all macros and search paths + CodeToolBoss.FPCDefinesCache.TestFilename:=CreateCompilerTestPascalFilename; + + // set global macros with CodeToolBoss.GlobalValues do begin Variables[ExternalMacroStart+'LazarusDir']:= EnvironmentOptions.LazarusDirectory; Variables[ExternalMacroStart+'ProjPath']:=VirtualDirectory; Variables[ExternalMacroStart+'LCLWidgetType']:= LCLPlatformDirNames[GetDefaultLCLWidgetType]; - Variables[ExternalMacroStart+'FPCSrcDir']:= - EnvironmentOptions.GetFPCSourceDirectory; end; - // build DefinePool and Define Tree - UpdateEnglishErrorMsgFilename; - with CodeToolBoss.DefinePool do begin - // start the compiler and ask for his settings - TargetOS:=''; - SetupCompilerFilename(InteractiveSetup); - TargetProcessor:=''; - MainBuildBoss.CurDefinesCompilerFilename:=EnvironmentOptions.CompilerFilename; - MainBuildBoss.CurDefinesCompilerOptions:=''; - MainBuildBoss.GetFPCCompilerParamsForEnvironmentTest( - MainBuildBoss.CurDefinesCompilerOptions); - //DebugLn('TMainIDE.InitCodeToolBoss CurDefinesCompilerOptions="',CurDefinesCompilerOptions,'"'); - CreateUseDefaultsFlagTemplate; + // find the compiler executable + SetupCompilerFilename(InteractiveSetup); + // find the FPC source directory + SetupFPCSourceDirectory(InteractiveSetup); + CodeToolBoss.GlobalValues.Variables[ExternalMacroStart+'FPCSrcDir']:= + EnvironmentOptions.GetFPCSourceDirectory; - ADefTempl:=CreateFPCTemplate(MainBuildBoss.CurDefinesCompilerFilename, - MainBuildBoss.CurDefinesCompilerOptions, - CreateCompilerTestPascalFilename,CompilerUnitSearchPath, - TargetOS,TargetProcessor,CodeToolsOpts); - AddTemplate(ADefTempl,false, - 'NOTE: Could not create Define Template for Free Pascal Compiler'); + // the first template is the "use default" flag + CreateUseDefaultsFlagTemplate; - // the compiler version was updated, now update the FPCSrcDir - SetupFPCSourceDirectory(InteractiveSetup); - CodeToolBoss.GlobalValues.Variables[ExternalMacroStart+'FPCSrcDir']:= - EnvironmentOptions.GetFPCSourceDirectory; + // create defines for the lazarus sources + SetupLazarusDirectory(InteractiveSetup); - // create compiler macros to simulate the Makefiles of the FPC sources - InputHistories.FPCConfigCache.CompilerPath:= - EnvironmentOptions.CompilerFilename; - CompilerUnitLinks:=InputHistories.FPCConfigCache.GetUnitLinks(''); - UnitLinksChanged:=InputHistories.LastFPCUnitLinksNeedsUpdate('', - CompilerUnitSearchPath,EnvironmentOptions.GetFPCSourceDirectory); - ADefTempl:=CreateFPCSourceTemplate( - CodeToolBoss.GlobalValues.Variables[ExternalMacroStart+'FPCSrcDir'], - CompilerUnitSearchPath, - CodeToolBoss.GetCompiledSrcExtForDirectory(''), - TargetOS,TargetProcessor, - not UnitLinksChanged,CompilerUnitLinks, - CodeToolsOpts); - - // save unitlinks - if UnitLinksChanged - or (CompilerUnitLinks<>InputHistories.FPCConfigCache.GetUnitLinks('')) - then begin - InputHistories.SetLastFPCUnitLinks(EnvironmentOptions.CompilerFilename, - '', // default options '' - CompilerUnitSearchPath, - EnvironmentOptions.GetFPCSourceDirectory, - CompilerUnitLinks); - InputHistories.Save; - end; - AddTemplate(ADefTempl,false, - lisNOTECouldNotCreateDefineTemplateForFreePascal); - - // create compiler macros for the lazarus sources - SetupLazarusDirectory(InteractiveSetup); - ADefTempl:=CreateLazarusSourceTemplate( - '$('+ExternalMacroStart+'LazarusDir)', - '$('+ExternalMacroStart+'LCLWidgetType)', - MiscellaneousOptions.BuildLazOpts.ExtraOptions,CodeToolsOpts); - AddTemplate(ADefTempl,true, - lisNOTECouldNotCreateDefineTemplateForLazarusSources); - end; + MainBuildBoss.RescanCompilerDefines(true,false); // load include file relationships AFilename:=AppendPathDelim(GetPrimaryConfigPath)+CodeToolsIncludeLinkFile; - if FileExistsUTF8(AFilename) then + if FileExistsCached(AFilename) then CodeToolBoss.SourceCache.LoadIncludeLinksFromFile(AFilename); with CodeToolBoss do begin @@ -13458,14 +13395,6 @@ begin CodeToolBoss.ConsistencyCheck; end; -procedure TMainIDE.UpdateEnglishErrorMsgFilename; -begin - if EnvironmentOptions.LazarusDirectory<>'' then - CodeToolBoss.DefinePool.EnglishErrorMsgFilename:= - AppendPathDelim(EnvironmentOptions.LazarusDirectory)+ - 'components'+PathDelim+'codetools'+PathDelim+'fpc.errore.msg'; -end; - procedure TMainIDE.ActivateCodeToolAbortableMode; begin if ToolStatus=itNone then diff --git a/ide/outputfilter.pas b/ide/outputfilter.pas index c6bef2a670..8579a28758 100644 --- a/ide/outputfilter.pas +++ b/ide/outputfilter.pas @@ -312,6 +312,8 @@ function TOutputFilter.Execute(TheProcess: TProcessUTF8; aCaller: TObject; aTool: TIDEExternalToolOptions): boolean; const BufSize = 4096; + NormalWait = ((double(1)/86400)/15); // 15 times per second + LongWait = ((double(1)/86400)/4); // 4 times per second var i, Count, LineStart : longint; OutputLine, Buf : String; @@ -319,6 +321,7 @@ var LastProcessMessages: TDateTime; EndUpdateNeeded: Boolean; ExceptionMsg: String; + Wait: double; begin Result:=true; FHasRaisedException := False; @@ -358,8 +361,9 @@ begin fProcess.Execute; LastProcessMessages:=Now-1;// force one update at start + Wait:=NormalWait; repeat - if (Application<>nil) and (abs(LastProcessMessages-Now)>((1/86400)/15)) + if (Application<>nil) and (abs(LastProcessMessages-Now)>Wait) then begin LastProcessMessages:=Now; if EndUpdateNeeded then begin @@ -425,6 +429,13 @@ begin end; inc(i); end; + if Count=length(Buf) then begin + // the buffer is full => process more and update the view less + Wait:=LongWait; + end else begin + // the buffer was not full => update more often + Wait:=NormalWait; + end; OutputLine:=OutputLine+copy(Buf,LineStart,Count-LineStart+1); until false; //DebugLn('TOutputFilter.Execute After Loop');