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

IDE: fixed nested macros, using default for FPCVer macro, bug #16008

Browse Source 
git-svn-id: trunk@24035 -
This commit is contained in:
mattias 2010-03-16 13:30:29 +00:00
parent fc19399e97
commit 09a6ed59f3
7 changed files with 58 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
ide/buildmanager.pas
View File

@ -1255,13 +1255,14 @@ function TBuildManager.MacroFuncFPCVer(const Param: string; const Data: PtrInt;
var Abort: boolean): string;
var
FPCVersion, FPCRelease, FPCPatch: integer;
Def: TDefineTemplate;
begin
Result:={$I %FPCVERSION%};
if CodeToolBoss<>nil then begin
CodeToolBoss.GetFPCVersionForDirectory('',FPCVersion,FPCRelease,FPCPatch);
if FPCVersion<>0 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);
end;
end;
end;

6
ide/compileroptions.pp
View File

@ -3399,7 +3399,8 @@ begin
end;
if ParsedStamp[Option]<>CompilerParseStamp then begin
if Parsing[Option] then begin
DebugLn('TParsedCompilerOptions.GetParsedValue Circle in Options: ',ParsedCompilerOptStringNames[Option]);
DebugLn('TParsedCompilerOptions.GetParsedValue Circle in Options: ',ParsedCompilerOptStringNames[Option],' Unparsed="',UnparsedValues[Option],'"');
RaiseException('');
exit('');
end;
Parsing[Option]:=true;
@ -3485,10 +3486,13 @@ begin
end;
end;
// parse locally
//DebugLn(['TParsedCompilerOptions.DoParseOption local "',s,'" ...']);
if Assigned(OnLocalSubstitute) then
s:=OnLocalSubstitute(s,PlatformIndependent);
// parse globally
//DebugLn(['TParsedCompilerOptions.DoParseOption global "',s,'" ...']);
s:=ParseString(Self,s,PlatformIndependent);
//DebugLn(['TParsedCompilerOptions.DoParseOption complete "',s,'" ...']);
// improve
if Option=pcosBaseDir then
// base directory (append path)

3
ide/helpmanager.pas
View File

@ -650,6 +650,9 @@ end;
function TIDEHelpDatabases.SubstituteMacros(var s: string): boolean;
begin
Result:=IDEMacros.SubstituteMacros(s);
DebugLn(['TIDEHelpDatabases.SubstituteMacros AAA1 ',s,' ',Result]);
Result:=IDEMacros.SubstituteMacros(s);
DebugLn(['TIDEHelpDatabases.SubstituteMacros AAA2 ',s,' ',Result]);
end;
{ TIDEHelpManager }

10
ide/main.pp
View File

@ -963,7 +963,8 @@ type
function GetTestBuildDirectory: string; override;
procedure OnMacroSubstitution(TheMacro: TTransferMacro;
const MacroName: string; var s: string;
const Data: PtrInt; var Handled, Abort: boolean);
const Data: PtrInt; var Handled, Abort: boolean;
Depth: integer);
procedure GetIDEFileState(Sender: TObject; const AFilename: string;
NeededFlags: TIDEFileStateFlags; out ResultFlags: TIDEFileStateFlags); override;
@ -11939,7 +11940,7 @@ end;
procedure TMainIDE.OnMacroSubstitution(TheMacro: TTransferMacro;
const MacroName: string; var s:string;
const Data: PtrInt; var Handled, Abort: boolean);
const Data: PtrInt; var Handled, Abort: boolean; Depth: integer);
var MacroLName:string;
begin
if TheMacro=nil then begin
@ -12904,8 +12905,9 @@ begin
CreateCompilerTestPascalFilename,CompilerUnitSearchPath,
TargetOS,TargetProcessor,CodeToolsOpts);
AddTemplate(ADefTempl,false,
'NOTE: Could not create Define Template for Free Pascal Compiler');
// the compiler version was updated, update the FPCSrcDir
'NOTE: Could not create Define Template for Free Pascal Compiler');
// the compiler version was updated, now update the FPCSrcDir
SetupFPCSourceDirectory(InteractiveSetup);
CodeToolBoss.GlobalValues.Variables[ExternalMacroStart+'FPCSrcDir']:=
EnvironmentOptions.GetFPCSourceDirectory;

33
ide/transfermacros.pp
View File

@ -52,7 +52,8 @@ type
TTransferMacro = class;
TOnSubstitution = procedure(TheMacro: TTransferMacro; const MacroName: string;
var s:string; const Data: PtrInt; var Handled, Abort: boolean) of object;
var s:string; const Data: PtrInt; var Handled, Abort: boolean;
Depth: integer) of object;
TMacroFunction = function(const s: string; const Data: PtrInt;
var Abort: boolean): string of object;
@ -100,7 +101,8 @@ type
procedure Delete(Index: integer);
procedure Add(NewMacro: TTransferMacro);
function FindByName(const MacroName: string): TTransferMacro; virtual;
function SubstituteStr(var s: string; const Data: PtrInt = 0): boolean; virtual;
function SubstituteStr(var s: string; const Data: PtrInt = 0;
Depth: integer = 0): boolean; virtual;
function StrHasMacros(const s: string): boolean;
property OnSubstitution: TOnSubstitution
read fOnSubstitution write fOnSubstitution;
@ -256,8 +258,8 @@ begin
// debugln('TTransferMacroList.Add A ',NewMacro.Name);
end;
function TTransferMacroList.SubstituteStr(var s:string; const Data: PtrInt
): boolean;
function TTransferMacroList.SubstituteStr(var s:string; const Data: PtrInt;
Depth: integer): boolean;
var
MacroStart,MacroEnd: integer;
MacroName, MacroStr, MacroParam: string;
@ -272,6 +274,7 @@ var
NewStringLen: Integer;
NewStringPos: Integer;
sLen: Integer;
LoopPos, LoopDepth: integer;
function SearchBracketClose(Position:integer): integer;
var BracketClose:char;
@ -288,9 +291,16 @@ var
end;
begin
if Depth>10 then begin
Result:=false;
s:='(macro loop detected)'+s;
exit;
end;
Result:=true;
sLen:=length(s);
MacroStart:=1;
LoopPos:=0;
LoopDepth:=1;
repeat
while (MacroStart<sLen) do begin
if (s[MacroStart]<>'$') then
@ -322,13 +332,13 @@ begin
// Macro function -> substitute macro parameter first
MacroParam:=copy(MacroStr,length(MacroName)+3,
length(MacroStr)-length(MacroName)-3);
if not SubstituteStr(MacroParam,Data) then begin
if not SubstituteStr(MacroParam,Data,Depth+1) then begin
Result:=false;
exit;
end;
AMacro:=FindByName(MacroName);
if Assigned(fOnSubstitution) then begin
fOnSubstitution(AMacro,MacroName,MacroParam,Data,Handled,Abort);
fOnSubstitution(AMacro,MacroName,MacroParam,Data,Handled,Abort,Depth+LoopDepth);
if Handled then
MacroStr:=MacroParam
else if Abort then begin
@ -350,7 +360,7 @@ begin
MacroName:=copy(s,MacroStart+2,OldMacroLen-3);
AMacro:=FindByName(MacroName);
if Assigned(fOnSubstitution) then begin
fOnSubstitution(AMacro,MacroName,MacroName,Data,Handled,Abort);
fOnSubstitution(AMacro,MacroName,MacroName,Data,Handled,Abort,Depth+LoopDepth);
if Handled then
MacroStr:=MacroName
else if Abort then begin
@ -379,6 +389,12 @@ begin
end;
// replace macro with new value
if Handled then begin
if MacroStart>=LoopPos then
LoopDepth:=1
else begin
inc(LoopDepth);
//DebugLn(['TTransferMacroList.SubstituteStr double macro: ',s,' Depth=',LoopDepth,' Pos=',LoopPos]);
end;
NewMacroLen:=length(MacroStr);
NewMacroEnd:=MacroStart+NewMacroLen;
InFrontOfMacroLen:=MacroStart-1;
@ -404,7 +420,8 @@ begin
s:=NewString;
sLen:=length(s);
// continue after the replacement
MacroEnd:=NewMacroEnd;
if NewMacroEnd>LoopPos then LoopPos:=NewMacroEnd;
MacroEnd:=MacroStart;
end;
end;
MacroStart:=MacroEnd;

19
packager/packagedefs.pas
View File

@ -684,7 +684,7 @@ type
procedure SetUserReadOnly(const AValue: boolean);
procedure OnMacroListSubstitution(TheMacro: TTransferMacro;
const MacroName: string; var s: string;
const Data: PtrInt; var Handled, Abort: boolean);
const Data: PtrInt; var Handled, Abort: boolean; Depth: integer);
procedure Clear;
procedure UpdateSourceDirectories;
procedure SourceDirectoriesChanged(Sender: TObject);
@ -769,7 +769,7 @@ type
procedure MoveRequiredDependencyDown(Dependency: TPkgDependency);
function CreateDependencyWithOwner(NewOwner: TObject): TPkgDependency;
function Requires(APackage: TLazPackage): boolean;
procedure GetAllRequiredPackages(var List: TFPList);
procedure GetAllRequiredPackages(var List: TFPList; WithSelf: boolean);
// components
function IndexOfPkgComponent(PkgComponent: TPkgComponent): integer;
function AddComponent(PkgFile: TPkgFile; const Page: string;
@ -2167,7 +2167,7 @@ end;
procedure TLazPackage.OnMacroListSubstitution(TheMacro: TTransferMacro;
const MacroName: string; var s: string; const Data: PtrInt;
var Handled, Abort: boolean);
var Handled, Abort: boolean; Depth: integer);
begin
if CompareText(s,'PkgOutDir')=0 then begin
Handled:=true;
@ -3379,10 +3379,19 @@ begin
Name:=NewName;
end;
procedure TLazPackage.GetAllRequiredPackages(var List: TFPList);
procedure TLazPackage.GetAllRequiredPackages(var List: TFPList;
WithSelf: boolean);
begin
if Assigned(OnGetAllRequiredPackages) then
OnGetAllRequiredPackages(FirstRequiredDependency,List);
if WithSelf then begin
if List=nil then List:=TFPList.Create;
if List.IndexOf(Self)<0 then;
List.Insert(0,Self);
end else if List<>nil then begin
List.Remove(Self);
if List.Count=0 then FreeAndNil(List);
end;
end;
procedure TLazPackage.GetInheritedCompilerOptions(var OptionsList: TFPList);
@ -3390,7 +3399,7 @@ var
PkgList: TFPList; // list of TLazPackage
begin
PkgList:=nil;
GetAllRequiredPackages(PkgList);
GetAllRequiredPackages(PkgList,false);
OptionsList:=GetUsageOptionsList(PkgList);
PkgList.Free;
end;

2
packager/pkgmanager.pas
View File

@ -3630,7 +3630,7 @@ begin
if Result<>mrOk then exit;
// get all required packages, which will also be auto installed
APackage.GetAllRequiredPackages(PkgList);
APackage.GetAllRequiredPackages(PkgList,false);
if PkgList=nil then PkgList:=TFPList.Create;
// remove packages already marked for installation