paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-02 13:19:49 +01:00
Code Issues Packages Projects Releases Wiki Activity

codetools: FindRealCompilerInPath: check for -Xp

Browse Source 
git-svn-id: trunk@44008 -
This commit is contained in:
mattias 2014-02-11 21:30:08 +00:00
parent 532192cab4
commit 37f6992f26
2 changed files with 97 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
components/codetools/definetemplates.pas
View File

@ -690,7 +690,7 @@ type
TargetOS: string; // will be passed lowercase
TargetCPU: string; // will be passed lowercase
Compiler: string; // full file name
CompilerOptions: string;
CompilerOptions: string; // e.g. -V<version> -Xp<path>
// values
CompilerDate: longint;
RealCompiler: string; // when Compiler is fpc, this is the real compiler (e.g. ppc386)
@ -945,6 +945,7 @@ function RunTool(const Filename: string; Params: TStrings;
WorkingDirectory: string = ''): TStringList;
function RunTool(const Filename, Params: string;
WorkingDirectory: string = ''): TStringList;
function ParseFPCInfo(FPCInfo: string; InfoTypes: TFPCInfoTypes;
out Infos: TFPCInfoStrings): boolean;
function RunFPCInfo(const CompilerFilename: string;
@ -7534,9 +7535,19 @@ function TFPCTargetConfigCache.FindRealCompilerInPath(aTargetCPU: string;
ResolveLinks: boolean): string;
function Search(const ShortFileName: string): string;
var
ExtPath: String;
begin
// fpc.exe first searches in -Xp
// Maybe: extract -Xp from extra options
// fpc.exe first searches in -Xp<path>
ExtPath:=GetLastFPCParameter(CompilerOptions,'-Xp');
if (ExtPath<>'') and (ExtPath<>'.') then begin
if not FilenameIsAbsolute(ExtPath) then
// If -Xp is relative then it is relative to the working directory
ExtPath:=TrimFilename(AppendPathDelim(GetCurrentDirUTF8)+ExtPath);
Result:=AppendPathDelim(ExtPath)+ShortFileName;
if FileExistsCached(Result) then
exit;
end;
// then fpc.exe searches in its own directory
if Compiler<>'' then begin
@ -7547,6 +7558,7 @@ function TFPCTargetConfigCache.FindRealCompilerInPath(aTargetCPU: string;
exit;
end;
end;
// finally fpc.exe searches in PATH
Result:=SearchFileInPath(ShortFileName,GetCurrentDirUTF8,
GetEnvironmentVariableUTF8('PATH'),PathSeparator,ctsfcDefault);

90
components/codetools/fileprocs.pas
View File

@ -196,6 +196,9 @@ function FindPathInSearchPath(APath: PChar; APathLen: integer;
// FPC
function ReadNextFPCParameter(const CmdLine: string; var Position: integer;
out StartPos: integer): boolean;
function ExtractFPCParameter(const CmdLine: string; StartPos: integer): string;
function FindNextFPCParameter(const CmdLine, BeginsWith: string; var Position: integer): integer;
function GetLastFPCParameter(const CmdLine, BeginsWith: string; CutBegins: boolean = true): string;
type
TCTPascalExtType = (petNone, petPAS, petPP, petP);
@ -1281,28 +1284,99 @@ end;
function ReadNextFPCParameter(const CmdLine: string; var Position: integer; out
StartPos: integer): boolean;
// reads till start of next FPC command line parameter, parses quotes ' and "
var
c: Char;
begin
StartPos:=Position;
while (StartPos<=length(CmdLine)) and (CmdLine[StartPos] in [' ',#9,#10,#13]) do
inc(StartPos);
Position:=StartPos;
while (Position<=length(CmdLine)) do begin
case CmdLine[Position] of
c:=CmdLine[Position];
case c of
' ',#9,#10,#13: break;
'''':
'''','"':
repeat
inc(Position);
until (Position>length(CmdLine)) or (CmdLine[Position]='''');
'"':
repeat
inc(Position);
until (Position>length(CmdLine)) or (CmdLine[Position]='''');
until (Position>length(CmdLine)) or (CmdLine[Position]=c);
end;
inc(Position);
end;
Result:=StartPos<=length(CmdLine);
end;
function ExtractFPCParameter(const CmdLine: string; StartPos: integer): string;
// returns a single FPC command line parameter, resolves quotes ' and "
var
p: Integer;
c: Char;
procedure Add;
begin
Result:=Result+copy(CmdLine,StartPos,p-StartPos);
end;
begin
Result:='';
p:=StartPos;
while (p<=length(CmdLine)) do begin
c:=CmdLine[p];
case c of
' ',#9,#10,#13: break;
'''','"':
begin
Add;
inc(p);
StartPos:=p;
while (p<=length(CmdLine)) do begin
if CmdLine[p]=c then begin
Add;
inc(p);
StartPos:=p;
break;
end;
inc(p);
end;
end;
end;
inc(p);
end;
Add;
end;
function FindNextFPCParameter(const CmdLine, BeginsWith: string;
var Position: integer): integer;
begin
if BeginsWith='' then
exit(-1);
while ReadNextFPCParameter(CmdLine,Position,Result) do
if LeftStr(ExtractFPCParameter(CmdLine,Result),length(BeginsWith))=BeginsWith
then
exit;
Result:=-1;
end;
function GetLastFPCParameter(const CmdLine, BeginsWith: string;
CutBegins: boolean): string;
var
Param: String;
p: Integer;
StartPos: integer;
begin
if BeginsWith='' then
exit('');
p:=1;
while ReadNextFPCParameter(CmdLine,p,StartPos) do begin
Param:=ExtractFPCParameter(CmdLine,StartPos);
if LeftStr(Param,length(BeginsWith))=BeginsWith then begin
Result:=Param;
if CutBegins then
System.Delete(Result,1,length(BeginsWith));
end;
end;
end;
function SearchFileInDir(const Filename, BaseDirectory: string;
SearchCase: TCTSearchFileCase): string;
@ -2093,7 +2167,7 @@ begin
Result:=p.ClassName;
end;
function dbgMemRange(P: System.PByte; Count: integer; Width: integer = 0): string;
function dbgMemRange(P: PByte; Count: integer; Width: integer): string;
const
HexChars: array[0..15] of char = '0123456789ABCDEF';
LineEnd: shortstring = LineEnding;