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

codetools: ParseFPCParameters: moved to other fpc option parse functions

Browse Source 
git-svn-id: trunk@53182 -
This commit is contained in:
mattias 2016-10-20 17:02:59 +00:00
parent de0adccd6e
commit bd2ab5c7bc
3 changed files with 399 additions and 399 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

399
components/codetools/definetemplates.pas
View File

@ -54,7 +54,7 @@ interface
uses
// RTL + FCL
Classes, SysUtils, AVL_Tree, process,
Classes, SysUtils, AVL_Tree, contnrs, process,
// CodeTools
CodeToolsStrConsts, ExprEval, DirectoryCacher, BasicCodeTools,
CodeToolsStructs, KeywordFuncLists, LinkScanner, FileProcs,
@ -1070,6 +1070,49 @@ procedure LoadFPCCacheFromFile(Filename: string;
procedure SaveFPCCacheToFile(Filename: string;
Configs: TFPCTargetConfigCaches; Sources: TFPCSourceCaches);
// 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 IndexOfFPCParamValue(ParsedParams: TObjectList { list of TFPCParamValue };
const Name: string): integer;
function GetFPCParamValue(ParsedParams: TObjectList { list of TFPCParamValue };
const Name: string): TFPCParamValue;
function dbgs(k: TFPCParamKind): string; overload;
function dbgs(f: TFPCParamFlag): string; overload;
function dbgs(const Flags: TFPCParamFlags): string; overload;
function ExtractFPCFrontEndParameters(const CmdLineParams: string;
const Kinds: TFPCFrontEndParams = AllFPCFrontEndParams): string;
@ -2642,6 +2685,360 @@ begin
end;
end;
{ TFPCParamValue }
constructor TFPCParamValue.Create(const aName, aValue: string;
aKind: TFPCParamKind; aFlags: TFPCParamFlags);
begin
Name:=aName;
Value:=aValue;
Kind:=aKind;
Flags:=aFlags;
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);
{ $DEFINE VerboseParseFPCParameter}
const
AlphaNum = ['a'..'z','A'..'Z','0'..'9'];
procedure Add(aName, aValue: string; aKind: TFPCParamKind; aFlags: TFPCParamFlags = []);
var
i: Integer;
Param: TFPCParamValue;
begin
{$IFDEF VerboseParseFPCParameter}
debugln(['ParseFPCParameter.Add Name="',aName,'" Value="',aValue,'" Kind=',dbgs(aKind),' Flags=',dbgs(aFlags)]);
{$ENDIF}
if (aName='O1') or (aName='O2') or (aName='O3') or (aName='O4') then begin
aValue:=aName[2];
aName:='O';
aKind:=fpkValue;
end;
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))
or (aKind<>Param.Kind) then
Include(Param.Flags,fpfValueChanged);
Param.Kind:=aKind;
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));
// alias
if aName='S2' then
Add('M','objfpc',fpkValue,aFlags)
else if aName='Sd' then
Add('M','delphi',fpkValue,aFlags)
else if aName='So' then
Add('M','tp',fpkValue,aFlags)
else if aName='?' then
Add('h',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);
{$IFDEF VerboseParseFPCParameter}
debugln(['ParseFPCParameter.AddBooleanFlag p="',p,'" Len=',Len,' Prefix="',Prefix,'" Name="'+aName+'"']);
{$ENDIF}
inc(p,Len);
if p^='-' then begin
Add(aName,'',fpkBoolean,[fpfUnset]);
inc(p);
end else begin
Add(aName,FPCParamEnabled,fpkBoolean);
if p^='+' 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
if not (p[1] in AlphaNum) then begin
AddBooleanFlag(p,1,'');
exit;
end;
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
{$IFDEF VerboseParseFPCParameter}
debugln(['ParseFPCParameter "',CmdLineParam,'"']);
{$ENDIF}
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(copy(CmdLineParam,3,255),'',fpkDefine);
'D':
begin
inc(p);
case p^ of
'd','v': Add('D'+p^,PChar(@p[1]),fpkValue);
else
AddBooleanFlag(p,1,'D');
end;
end;
'e': Add('e',PChar(@p[1]),fpkValue);
'F':
case p[1] of
'a','f','i','l','o','u': Add('Fa',PChar(@p[2]),fpkMultiValue);
'c','C','D','e','E','L','m','M','r','R','U','W','w': Add('F'+p[1],PChar(@p[2]),fpkValue);
else AddBooleanFlag(p,2);
end;
'g':
if p[1] in [#0,'+'] then begin
Add('g',FPCParamEnabled,fpkBoolean,[]);
end else if p[1]='-' then begin
DisableAllFlags('g');
Add('g','',fpkBoolean,[fpfUnset]);
end else begin
inc(p);
repeat
case p^ of
'o':
begin
Add('g'+p,FPCParamEnabled,fpkBoolean,[]);
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,'SO SP TO TP');
'I': Add(p^,PChar(@p[1]),fpkMultiValue);
'k': Add(p^,PChar(@p[1]),fpkMultiValue);
'M': Add(p^,PChar(@p[1]),fpkValue);
'o': Add(p^,PChar(@p[1]),fpkValue);
'O':
case p[1] of
'-': DisableAllFlags('O');
else
ReadSequence(p,'a= o* p: W: w:');
end;
'P': ; // ToDo
'R': Add(p^,PChar(@p[1]),fpkValue);
'S': ReadSequence(p,'e: I:');
's': ReadSequence(p);
'T': Add(p^,PChar(@p[1]),fpkValue);
'u': Add(copy(CmdLineParam,3,255),'',fpkDefine,[fpfUnset]);
'U': ReadSequence(p);
'v': ReadSequence(p,'m&');
'V': Add(p^,PChar(@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('',PChar(@p[1]),fpkConfig);
else
// filename
Add('',p,fpkNonOption);
end;
end;
function IndexOfFPCParamValue(ParsedParams: TObjectList; const Name: string
): integer;
begin
if ParsedParams=nil then exit(-1);
for Result:=0 to ParsedParams.Count-1 do
if TFPCParamValue(ParsedParams[Result]).Name=Name then exit;
Result:=-1;
end;
function GetFPCParamValue(ParsedParams: TObjectList; const Name: string
): TFPCParamValue;
var
i: Integer;
begin
i:=IndexOfFPCParamValue(ParsedParams,Name);
if i<0 then
Result:=nil
else
Result:=TFPCParamValue(ParsedParams[i]);
end;
function dbgs(k: TFPCParamKind): string;
begin
str(k,Result);
end;
function dbgs(f: TFPCParamFlag): string;
begin
str(f,Result);
end;
function dbgs(const Flags: TFPCParamFlags): string;
var
f: TFPCParamFlag;
begin
Result:='';
for f in TFPCParamFlag do
if f in Flags then begin
if Result<>'' then Result+=',';
Result+=dbgs(f);
end;
Result:='['+Result+']';
end;
function ExtractFPCFrontEndParameters(const CmdLineParams: string;
const Kinds: TFPCFrontEndParams): string;
// extract the parameters for the FPC frontend tool fpc.exe

397
components/codetools/fileprocs.pas
View File

@ -233,49 +233,6 @@ function SearchPascalFileInDir(const ShortFilename, BaseDirectory: string;
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 IndexOfFPCParamValue(ParsedParams: TObjectList { list of TFPCParamValue };
const Name: string): integer;
function GetFPCParamValue(ParsedParams: TObjectList { list of TFPCParamValue };
const Name: string): TFPCParamValue;
function dbgs(k: TFPCParamKind): string; overload;
function dbgs(f: TFPCParamFlag): string; overload;
function dbgs(const Flags: TFPCParamFlags): string; overload;
function ReadNextFPCParameter(const CmdLine: string; var Position: integer;
out StartPos: integer): boolean;
function ExtractFPCParameter(const CmdLine: string; StartPos: integer): string;
@ -1443,349 +1400,6 @@ 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);
{ $DEFINE VerboseParseFPCParameter}
const
AlphaNum = ['a'..'z','A'..'Z','0'..'9'];
procedure Add(aName, aValue: string; aKind: TFPCParamKind; aFlags: TFPCParamFlags = []);
var
i: Integer;
Param: TFPCParamValue;
begin
{$IFDEF VerboseParseFPCParameter}
debugln(['ParseFPCParameter.Add Name="',aName,'" Value="',aValue,'" Kind=',dbgs(aKind),' Flags=',dbgs(aFlags)]);
{$ENDIF}
if (aName='O1') or (aName='O2') or (aName='O3') or (aName='O4') then begin
aValue:=aName[2];
aName:='O';
aKind:=fpkValue;
end;
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))
or (aKind<>Param.Kind) then
Include(Param.Flags,fpfValueChanged);
Param.Kind:=aKind;
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));
// alias
if aName='S2' then
Add('M','objfpc',fpkValue,aFlags)
else if aName='Sd' then
Add('M','delphi',fpkValue,aFlags)
else if aName='So' then
Add('M','tp',fpkValue,aFlags)
else if aName='?' then
Add('h',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);
{$IFDEF VerboseParseFPCParameter}
debugln(['ParseFPCParameter.AddBooleanFlag p="',p,'" Len=',Len,' Prefix="',Prefix,'" Name="'+aName+'"']);
{$ENDIF}
inc(p,Len);
if p^='-' then begin
Add(aName,'',fpkBoolean,[fpfUnset]);
inc(p);
end else begin
Add(aName,FPCParamEnabled,fpkBoolean);
if p^='+' 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
if not (p[1] in AlphaNum) then begin
AddBooleanFlag(p,1,'');
exit;
end;
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
{$IFDEF VerboseParseFPCParameter}
debugln(['ParseFPCParameter "',CmdLineParam,'"']);
{$ENDIF}
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(copy(CmdLineParam,3,255),'',fpkDefine);
'D':
begin
inc(p);
case p^ of
'd','v': Add('D'+p^,PChar(@p[1]),fpkValue);
else
AddBooleanFlag(p,1,'D');
end;
end;
'e': Add('e',PChar(@p[1]),fpkValue);
'F':
case p[1] of
'a','f','i','l','o','u': Add('Fa',PChar(@p[2]),fpkMultiValue);
'c','C','D','e','E','L','m','M','r','R','U','W','w': Add('F'+p[1],PChar(@p[2]),fpkValue);
else AddBooleanFlag(p,2);
end;
'g':
if p[1] in [#0,'+'] then begin
Add('g',FPCParamEnabled,fpkBoolean,[]);
end else if p[1]='-' then begin
DisableAllFlags('g');
Add('g','',fpkBoolean,[fpfUnset]);
end else begin
inc(p);
repeat
case p^ of
'o':
begin
Add('g'+p,FPCParamEnabled,fpkBoolean,[]);
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,'SO SP TO TP');
'I': Add(p^,PChar(@p[1]),fpkMultiValue);
'k': Add(p^,PChar(@p[1]),fpkMultiValue);
'M': Add(p^,PChar(@p[1]),fpkValue);
'o': Add(p^,PChar(@p[1]),fpkValue);
'O':
case p[1] of
'-': DisableAllFlags('O');
else
ReadSequence(p,'a= o* p: W: w:');
end;
'P': ; // ToDo
'R': Add(p^,PChar(@p[1]),fpkValue);
'S': ReadSequence(p,'e: I:');
's': ReadSequence(p);
'T': Add(p^,PChar(@p[1]),fpkValue);
'u': Add(copy(CmdLineParam,3,255),'',fpkDefine,[fpfUnset]);
'U': ReadSequence(p);
'v': ReadSequence(p,'m&');
'V': Add(p^,PChar(@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('',PChar(@p[1]),fpkConfig);
else
// filename
Add('',p,fpkNonOption);
end;
end;
function IndexOfFPCParamValue(ParsedParams: TObjectList; const Name: string
): integer;
begin
if ParsedParams=nil then exit(-1);
for Result:=0 to ParsedParams.Count-1 do
if TFPCParamValue(ParsedParams[Result]).Name=Name then exit;
Result:=-1;
end;
function GetFPCParamValue(ParsedParams: TObjectList; const Name: string
): TFPCParamValue;
var
i: Integer;
begin
i:=IndexOfFPCParamValue(ParsedParams,Name);
if i<0 then
Result:=nil
else
Result:=TFPCParamValue(ParsedParams[i]);
end;
function dbgs(k: TFPCParamKind): string;
begin
str(k,Result);
end;
function dbgs(f: TFPCParamFlag): string;
begin
str(f,Result);
end;
function dbgs(const Flags: TFPCParamFlags): string;
var
f: TFPCParamFlag;
begin
Result:='';
for f in TFPCParamFlag do
if f in Flags then begin
if Result<>'' then Result+=',';
Result+=dbgs(f);
end;
Result:='['+Result+']';
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 "
@ -2823,17 +2437,6 @@ 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;

2
components/codetools/tests/testbasiccodetools.pas
View File

@ -23,7 +23,7 @@ interface
uses
fpcunit, contnrs, Classes, SysUtils, testglobals, FileProcs, BasicCodeTools,
SourceLog;
SourceLog, DefineTemplates;
type
{ TTestBasicCodeTools }