paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-16 02:10:08 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: using new codetools FPC caches

Browse Source 
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 -
This commit is contained in:
mattias 2010-07-24 08:12:27 +00:00
parent 0554e1ce9e
commit 5f4f03d6e9
17 changed files with 638 additions and 551 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
components/aggpas/lazarus/example/AggPasInLCLDemo2.lpi
View File

@ -1,7 +1,7 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="7"/>
<Version Value="8"/>
<General>
<SessionStorage Value="InIDEConfig"/>
<MainUnit Value="0"/>
@ -9,7 +9,7 @@
<Title Value="AggPasInLCLDemo2"/>
</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>

64
components/codetools/codetoolmanager.pas
View File

@ -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;

151
components/codetools/definetemplates.pas
View File

@ -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

6
components/codetools/directorycacher.pas
View File

@ -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,'"']);

207
components/codetools/identcompletiontool.pas
View File

@ -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 }

2
components/codetools/pascalparsertool.pas
View File

@ -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

94
components/synedit/test/testbase.pas
View File

@ -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;

8
ide/basebuildmanager.pas
View File

@ -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;

339
ide/buildmanager.pas
View File

@ -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;

53
ide/codebrowser.pas
View File

@ -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;

83
ide/codetoolsdefines.pas
View File

@ -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;

2
ide/codetoolsoptions.pas
View File

@ -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;

2
ide/lazarusidestrconsts.pas
View File

@ -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';

2
ide/lazbuild.lpi
View File

@ -1,7 +1,7 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="7"/>
<Version Value="8"/>
<General>
<Flags>
<LRSInOutputDirectory Value="False"/>

5
ide/lazbuild.lpr
View File

@ -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;

147
ide/main.pp
View File

@ -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

13
ide/outputfilter.pas
View File

@ -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');