mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-12 13:17:18 +02:00
codetools: started ParseFPCParameter
git-svn-id: trunk@53155 -
This commit is contained in:
mattias
parent
ce7d2bf070
commit
ebe105f987
@ -1026,8 +1026,6 @@ function ParseFPCInfo(FPCInfo: string; InfoTypes: TFPCInfoTypes;
|
||||
out Infos: TFPCInfoStrings): boolean;
|
||||
function RunFPCInfo(const CompilerFilename: string;
|
||||
InfoTypes: TFPCInfoTypes; const Options: string =''): string;
|
||||
function ExtractFPCFrontEndParameters(const CmdLineParams: string;
|
||||
const Kinds: TFPCFrontEndParams = AllFPCFrontEndParams): string;
|
||||
function FPCVersionToNumber(const FPCVersionString: string): integer;
|
||||
function SplitFPCVersion(const FPCVersionString: string;
|
||||
out FPCVersion, FPCRelease, FPCPatch: integer): boolean;
|
||||
@ -1072,6 +1070,9 @@ procedure LoadFPCCacheFromFile(Filename: string;
|
||||
procedure SaveFPCCacheToFile(Filename: string;
|
||||
Configs: TFPCTargetConfigCaches; Sources: TFPCSourceCaches);
|
||||
|
||||
function ExtractFPCFrontEndParameters(const CmdLineParams: string;
|
||||
const Kinds: TFPCFrontEndParams = AllFPCFrontEndParams): string;
|
||||
|
||||
procedure ReadMakefileFPC(const Filename: string; List: TStrings);
|
||||
procedure ParseMakefileFPC(const Filename, SrcOS: string;
|
||||
out Dirs, SubDirs: string);
|
||||
@ -1443,54 +1444,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function ExtractFPCFrontEndParameters(const CmdLineParams: string;
|
||||
const Kinds: TFPCFrontEndParams): string;
|
||||
// extract the parameters for the FPC frontend tool fpc.exe
|
||||
// The result is normalized:
|
||||
// - only the last value
|
||||
// - order is: -T -P -V -Xp
|
||||
|
||||
procedure Add(const Name, Value: string);
|
||||
begin
|
||||
if Value='' then exit;
|
||||
if Result<>'' then Result+=' ';
|
||||
Result+='-'+Name+StrToCmdLineParam(Value);
|
||||
end;
|
||||
|
||||
var
|
||||
Position: Integer;
|
||||
Param, ParamT, ParamP, ParamV, ParamXp: String;
|
||||
StartPos: integer;
|
||||
p: PChar;
|
||||
begin
|
||||
Result:='';
|
||||
ParamT:='';
|
||||
ParamP:='';
|
||||
ParamV:='';
|
||||
ParamXp:='';
|
||||
Position:=1;
|
||||
while ReadNextFPCParameter(CmdLineParams,Position,StartPos) do begin
|
||||
Param:=ExtractFPCParameter(CmdLineParams,StartPos);
|
||||
if Param='' then continue;
|
||||
p:=PChar(Param);
|
||||
if p^<>'-' then continue;
|
||||
case p[1] of
|
||||
'T': if fpcpT in Kinds then ParamT:=copy(Param,3,255);
|
||||
'P': if fpcpP in Kinds then ParamP:=copy(Param,3,255);
|
||||
'V': if fpcpV in Kinds then ParamV:=copy(Param,3,length(Param));
|
||||
'X':
|
||||
case p[2] of
|
||||
'p': if fpcpXp in Kinds then ParamXp:=copy(Param,4,length(Param));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
// add parameters
|
||||
Add('Xp',ParamXp);
|
||||
Add('T',ParamT);
|
||||
Add('P',ParamP);
|
||||
Add('V',ParamV);
|
||||
end;
|
||||
|
||||
function FPCVersionToNumber(const FPCVersionString: string): integer;
|
||||
var
|
||||
FPCVersion, FPCRelease, FPCPatch: integer;
|
||||
@ -2689,6 +2642,54 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function ExtractFPCFrontEndParameters(const CmdLineParams: string;
|
||||
const Kinds: TFPCFrontEndParams): string;
|
||||
// extract the parameters for the FPC frontend tool fpc.exe
|
||||
// The result is normalized:
|
||||
// - only the last value
|
||||
// - order is: -T -P -V -Xp
|
||||
|
||||
procedure Add(const Name, Value: string);
|
||||
begin
|
||||
if Value='' then exit;
|
||||
if Result<>'' then Result+=' ';
|
||||
Result+='-'+Name+StrToCmdLineParam(Value);
|
||||
end;
|
||||
|
||||
var
|
||||
Position: Integer;
|
||||
Param, ParamT, ParamP, ParamV, ParamXp: String;
|
||||
StartPos: integer;
|
||||
p: PChar;
|
||||
begin
|
||||
Result:='';
|
||||
ParamT:='';
|
||||
ParamP:='';
|
||||
ParamV:='';
|
||||
ParamXp:='';
|
||||
Position:=1;
|
||||
while ReadNextFPCParameter(CmdLineParams,Position,StartPos) do begin
|
||||
Param:=ExtractFPCParameter(CmdLineParams,StartPos);
|
||||
if Param='' then continue;
|
||||
p:=PChar(Param);
|
||||
if p^<>'-' then continue;
|
||||
case p[1] of
|
||||
'T': if fpcpT in Kinds then ParamT:=copy(Param,3,255);
|
||||
'P': if fpcpP in Kinds then ParamP:=copy(Param,3,255);
|
||||
'V': if fpcpV in Kinds then ParamV:=copy(Param,3,length(Param));
|
||||
'X':
|
||||
case p[2] of
|
||||
'p': if fpcpXp in Kinds then ParamXp:=copy(Param,4,length(Param));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
// add parameters
|
||||
Add('Xp',ParamXp);
|
||||
Add('T',ParamT);
|
||||
Add('P',ParamP);
|
||||
Add('V',ParamV);
|
||||
end;
|
||||
|
||||
procedure ReadMakefileFPC(const Filename: string; List: TStrings);
|
||||
var
|
||||
MakefileFPC: TStringListUTF8;
|
||||
|
||||
@ -40,7 +40,7 @@ uses
|
||||
Windows,
|
||||
{$ENDIF}
|
||||
// RTL + FCL
|
||||
Classes, SysUtils, AVL_Tree,
|
||||
Classes, SysUtils, AVL_Tree, contnrs,
|
||||
// CodeTools
|
||||
CodeToolsStrConsts,
|
||||
// LazUtils
|
||||
@ -234,6 +234,41 @@ function SearchPascalFileInPath(const ShortFilename, BasePath, SearchPath,
|
||||
Delimiter: string; SearchCase: TCTSearchFileCase): string;
|
||||
|
||||
// FPC
|
||||
const
|
||||
FPCParamEnabled = 'true';
|
||||
|
||||
type
|
||||
TFPCParamKind = (
|
||||
fpkUnknown,
|
||||
fpkBoolean, // Values: true = FPCParamEnabled otherwise false
|
||||
fpkValue,
|
||||
fpkMultiValue, // e.g. -k
|
||||
fpkDefine, // -d and -u options
|
||||
fpkConfig, // @ parameter
|
||||
fpkNonOption // e.g. source file
|
||||
);
|
||||
TFPCParamFlag = (
|
||||
fpfUnset, // use default, e.g. turns an fpkDefine into an Undefine
|
||||
fpfSetTwice,
|
||||
fpfValueChanged);
|
||||
TFPCParamFlags = set of TFPCParamFlag;
|
||||
|
||||
{ TFPCParamValue }
|
||||
|
||||
TFPCParamValue = class
|
||||
public
|
||||
Name: string;
|
||||
Value: string;
|
||||
Kind: TFPCParamKind;
|
||||
Flags: TFPCParamFlags;
|
||||
constructor Create(const aName, aValue: string; aKind: TFPCParamKind; aFlags: TFPCParamFlags = []);
|
||||
end;
|
||||
procedure ParseFPCParameters(const CmdLineParams: string;
|
||||
Params: TObjectList { list of TFPCParamValue }; ReadBackslash: boolean = false);
|
||||
procedure ParseFPCParameters(CmdLineParams: TStrings;
|
||||
ParsedParams: TObjectList { list of TFPCParamValue });
|
||||
procedure ParseFPCParameter(const CmdLineParam: string;
|
||||
ParsedParams: TObjectList { list of TFPCParamValue });
|
||||
function ReadNextFPCParameter(const CmdLine: string; var Position: integer;
|
||||
out StartPos: integer): boolean;
|
||||
function ExtractFPCParameter(const CmdLine: string; StartPos: integer): string;
|
||||
@ -1401,6 +1436,267 @@ begin
|
||||
Result:='';
|
||||
end;
|
||||
|
||||
procedure ParseFPCParameters(const CmdLineParams: string;
|
||||
Params: TObjectList; ReadBackslash: boolean);
|
||||
var
|
||||
ParamList: TStringList;
|
||||
begin
|
||||
ParamList:=TStringList.Create;
|
||||
try
|
||||
SplitCmdLineParams(CmdLineParams,ParamList,ReadBackslash);
|
||||
ParseFPCParameters(ParamList,Params);
|
||||
finally
|
||||
ParamList.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure ParseFPCParameters(CmdLineParams: TStrings;
|
||||
ParsedParams: TObjectList);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
if (CmdLineParams=nil) or (CmdLineParams.Count=0) or (ParsedParams=nil) then exit;
|
||||
for i:=0 to CmdLineParams.Count-1 do
|
||||
ParseFPCParameter(CmdLineParams[i],ParsedParams);
|
||||
end;
|
||||
|
||||
procedure ParseFPCParameter(const CmdLineParam: string;
|
||||
ParsedParams: TObjectList);
|
||||
const
|
||||
AlphaNum = ['a'..'z','A'..'Z','0'..'9'];
|
||||
|
||||
procedure Add(const aName, aValue: string; aKind: TFPCParamKind; aFlags: TFPCParamFlags = []);
|
||||
var
|
||||
i: Integer;
|
||||
Param: TFPCParamValue;
|
||||
begin
|
||||
if not (aKind in [fpkUnknown,fpkConfig,fpkNonOption,fpkMultiValue]) then
|
||||
// check for duplicates
|
||||
for i:=0 to ParsedParams.Count-1 do begin
|
||||
Param:=TFPCParamValue(ParsedParams[i]);
|
||||
if (Param.Name<>aName) then continue;
|
||||
if (aKind=fpkDefine) <> (Param.Kind=fpkDefine) then continue;
|
||||
// was already set
|
||||
Include(Param.Flags,fpfSetTwice);
|
||||
if (aValue<>Param.Value) or ((fpfUnset in aFlags)<>(fpfUnset in Param.Flags)) then
|
||||
Include(Param.Flags,fpfValueChanged);
|
||||
Param.Value:=aValue;
|
||||
if fpfUnset in aFlags then
|
||||
Include(Param.Flags,fpfUnset)
|
||||
else
|
||||
Exclude(Param.Flags,fpfUnset);
|
||||
exit;
|
||||
end;
|
||||
ParsedParams.Add(TFPCParamValue.Create(aName, aValue, aKind, aFlags));
|
||||
end;
|
||||
|
||||
procedure AddBooleanFlag(var p: PChar; Len: integer; Prefix: string = '');
|
||||
var
|
||||
aName: string;
|
||||
PrefixLen: Integer;
|
||||
begin
|
||||
PrefixLen:=length(Prefix);
|
||||
SetLength(aName,PrefixLen+Len);
|
||||
if PrefixLen>0 then
|
||||
Move(Prefix[1],aName[1],PrefixLen);
|
||||
if Len>0 then
|
||||
Move(p^,aName[PrefixLen+1],Len);
|
||||
inc(p,Len);
|
||||
if p[1]='-' then begin
|
||||
Add(aName,'',fpkBoolean,[fpfUnset]);
|
||||
inc(p);
|
||||
end else begin
|
||||
Add(aName,FPCParamEnabled,fpkBoolean);
|
||||
if p[1]='+' then
|
||||
inc(p);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure ReadSequence(p: PChar;
|
||||
const Specials: string = '');
|
||||
// e.g. -Ci-n+o p points to the 'C'
|
||||
// Specials is a space separated list of params:
|
||||
// SO : a two letter option 'SO'
|
||||
// h: : a one letter option 'h' followed by a value
|
||||
// ma& : a two letter option 'ma' followed by a multi value
|
||||
// T* : a boolean option starting with T, e.g. Tcld
|
||||
// P= : a one letter option 'P' followed by a name=value pair
|
||||
var
|
||||
Option, c: Char;
|
||||
Opt, Opt2, p2: PChar;
|
||||
aName: string;
|
||||
begin
|
||||
Option:=p^;
|
||||
inc(p);
|
||||
repeat
|
||||
c:=p^;
|
||||
if not (c in AlphaNum) then
|
||||
break; // invalid option
|
||||
if (p[1]<>#0) and (Specials<>'') then begin
|
||||
Opt:=PChar(Specials);
|
||||
while Opt^<>#0 do begin
|
||||
while Opt^=' ' do inc(Opt);
|
||||
p2:=p;
|
||||
Opt2:=Opt;
|
||||
while (Opt2^ in AlphaNum) and (p2^=Opt2^) do begin
|
||||
inc(p2);
|
||||
inc(Opt2);
|
||||
end;
|
||||
case Opt2^ of
|
||||
' ',#0: // boolean option
|
||||
begin
|
||||
AddBooleanFlag(p,Opt2-Opt,Option);
|
||||
break;
|
||||
end;
|
||||
':': // option followed by value
|
||||
begin
|
||||
Add(Option+copy(Specials,Opt-PChar(Specials)+1,Opt2-Opt),p2,fpkValue);
|
||||
exit;
|
||||
end;
|
||||
'&': // option followed by multi value
|
||||
begin
|
||||
Add(Option+copy(Specials,Opt-PChar(Specials)+1,Opt2-Opt),p2,fpkMultiValue);
|
||||
exit;
|
||||
end;
|
||||
'*': // boolean option with arbitrary name
|
||||
begin
|
||||
while p2^ in AlphaNum do inc(p2);
|
||||
AddBooleanFlag(p,p2-p,Option);
|
||||
break;
|
||||
end;
|
||||
'=': // name=value
|
||||
begin
|
||||
if not (p2^ in AlphaNum) then exit; // invalid option
|
||||
while p2^ in AlphaNum do inc(p2);
|
||||
if (p2^<>'=') then exit; // invalid option
|
||||
SetLength(aName,p2-p);
|
||||
Move(p^,aName[1],p2-p);
|
||||
inc(p2);
|
||||
Add(Option+aName,p2,fpkValue);
|
||||
exit;
|
||||
end
|
||||
else
|
||||
// mismatch -> try next special option
|
||||
Opt:=Opt2;
|
||||
while not (Opt^ in [#0,' ']) do inc(Opt);
|
||||
end;
|
||||
end;
|
||||
if Opt^<>#0 then continue;
|
||||
end;
|
||||
// default: single char flag
|
||||
AddBooleanFlag(p,1,Option);
|
||||
until false;
|
||||
end;
|
||||
|
||||
procedure DisableAllFlags(const Prefix: string);
|
||||
var
|
||||
i: Integer;
|
||||
Param: TFPCParamValue;
|
||||
begin
|
||||
for i:=0 to ParsedParams.Count-1 do begin
|
||||
Param:=TFPCParamValue(ParsedParams[i]);
|
||||
if not (Param.Kind in [fpkBoolean,fpkValue,fpkMultiValue]) then continue;
|
||||
if LeftStr(Param.Name,length(Prefix))<>Prefix then continue;
|
||||
Include(Param.Flags,fpfSetTwice);
|
||||
if not (fpfUnset in Param.Flags) then
|
||||
Include(Param.Flags,fpfValueChanged);
|
||||
Param.Value:='';
|
||||
Include(Param.Flags,fpfUnset);
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
p, p2: PChar;
|
||||
begin
|
||||
if CmdLineParam='' then exit;
|
||||
p:=PChar(CmdLineParam);
|
||||
case p^ of
|
||||
'-': // option
|
||||
begin
|
||||
inc(p);
|
||||
case p^ of
|
||||
'a': ReadSequence(p);
|
||||
'C': ReadSequence(p,'a: c: f: F: h: p: P= s: T*');
|
||||
'd': Add(p[1],'',fpkDefine);
|
||||
'D':
|
||||
begin
|
||||
inc(p);
|
||||
case p^ of
|
||||
'd','v': Add('D'+p^,p[1],fpkValue);
|
||||
else
|
||||
AddBooleanFlag(p,1,'D');
|
||||
end;
|
||||
end;
|
||||
'e': Add('e',p[1],fpkValue);
|
||||
'F':
|
||||
case p[1] of
|
||||
'a','f','i','l','o','u': Add('Fa',p[2],fpkMultiValue);
|
||||
'c','C','D','e','E','L','m','M','r','R','U','W','w': Add('F'+p[1],p[2],fpkValue);
|
||||
else AddBooleanFlag(p,2);
|
||||
end;
|
||||
'g':
|
||||
begin
|
||||
inc(p);
|
||||
repeat
|
||||
case p^ of
|
||||
'o':
|
||||
begin
|
||||
AddBooleanFlag(p,1,'g');
|
||||
exit;
|
||||
end;
|
||||
'w':
|
||||
case p[1] of
|
||||
'2'..'9':
|
||||
begin
|
||||
Add('gw',p[1],fpkValue);
|
||||
inc(p,2);
|
||||
end;
|
||||
else
|
||||
Add('gw','2',fpkValue);
|
||||
inc(p);
|
||||
end;
|
||||
'a'..'n','p'..'v','A'..'Z','0'..'9':
|
||||
AddBooleanFlag(p,1,'g');
|
||||
else
|
||||
break;
|
||||
end;
|
||||
until false;
|
||||
end;
|
||||
'i': ReadSequence(p,'S* T*');
|
||||
'I': Add(p^,p[1],fpkMultiValue);
|
||||
'k': Add(p^,p[1],fpkMultiValue);
|
||||
'M': Add(p^,p[1],fpkValue);
|
||||
'o': Add(p^,p[1],fpkValue);
|
||||
'O':
|
||||
case p[1] of
|
||||
'-': DisableAllFlags('O');
|
||||
else
|
||||
ReadSequence(p,'a= o* p: W:');
|
||||
end;
|
||||
'P': ; // ToDo
|
||||
'R': Add(p^,p[1],fpkValue);
|
||||
'S': ReadSequence(p,'e: I:');
|
||||
'T': Add(p^,p[1],fpkValue);
|
||||
'u': Add(p[1],'',fpkDefine,[fpfUnset]);
|
||||
'U': ReadSequence(p);
|
||||
'v': ReadSequence(p,'m&');
|
||||
'V': Add(p^,p[1],fpkValue);
|
||||
'W': ReadSequence(p,'B: M: P:');
|
||||
'X': ReadSequence(p,'LA LO LD M: P: r: R:');
|
||||
else
|
||||
p2:=p;
|
||||
while p2^ in AlphaNum do inc(p2);
|
||||
AddBooleanFlag(p,p2-p);
|
||||
end;
|
||||
end;
|
||||
'@': // config
|
||||
Add('',p[1],fpkConfig);
|
||||
else
|
||||
// filename
|
||||
Add('',p,fpkNonOption);
|
||||
end;
|
||||
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 "
|
||||
@ -2438,6 +2734,17 @@ begin
|
||||
LineInfoCache:=nil;
|
||||
end;
|
||||
|
||||
{ TFPCParamValue }
|
||||
|
||||
constructor TFPCParamValue.Create(const aName, aValue: string;
|
||||
aKind: TFPCParamKind; aFlags: TFPCParamFlags);
|
||||
begin
|
||||
Name:=aName;
|
||||
Value:=aValue;
|
||||
Kind:=aKind;
|
||||
Flags:=aFlags;
|
||||
end;
|
||||
|
||||
{ TCTMemStats }
|
||||
|
||||
function TCTMemStats.GetItems(const Name: string): PtrUint;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user