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

codetools: started ParseFPCParameters

Browse Source 
git-svn-id: trunk@53180 -
This commit is contained in:
mattias 2016-10-20 16:24:52 +00:00
parent 01e9778944
commit 3610fd18b2
2 changed files with 170 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

107
components/codetools/fileprocs.pas
View File

@ -269,6 +269,13 @@ procedure ParseFPCParameters(CmdLineParams: TStrings;
ParsedParams: TObjectList { list of TFPCParamValue }); ParsedParams: TObjectList { list of TFPCParamValue });
procedure ParseFPCParameter(const CmdLineParam: string; procedure ParseFPCParameter(const CmdLineParam: string;
ParsedParams: TObjectList { list of TFPCParamValue }); 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; function ReadNextFPCParameter(const CmdLine: string; var Position: integer;
out StartPos: integer): boolean; out StartPos: integer): boolean;
function ExtractFPCParameter(const CmdLine: string; StartPos: integer): string; function ExtractFPCParameter(const CmdLine: string; StartPos: integer): string;
@ -1462,6 +1469,7 @@ end;
procedure ParseFPCParameter(const CmdLineParam: string; procedure ParseFPCParameter(const CmdLineParam: string;
ParsedParams: TObjectList); ParsedParams: TObjectList);
{ $DEFINE VerboseParseFPCParameter}
const const
AlphaNum = ['a'..'z','A'..'Z','0'..'9']; AlphaNum = ['a'..'z','A'..'Z','0'..'9'];
@ -1470,6 +1478,9 @@ const
i: Integer; i: Integer;
Param: TFPCParamValue; Param: TFPCParamValue;
begin begin
{$IFDEF VerboseParseFPCParameter}
debugln(['ParseFPCParameter.Add Name="',aName,'" Value="',aValue,'" Kind=',dbgs(aKind),' Flags=',dbgs(aFlags)]);
{$ENDIF}
if not (aKind in [fpkUnknown,fpkConfig,fpkNonOption,fpkMultiValue]) then if not (aKind in [fpkUnknown,fpkConfig,fpkNonOption,fpkMultiValue]) then
// check for duplicates // check for duplicates
for i:=0 to ParsedParams.Count-1 do begin for i:=0 to ParsedParams.Count-1 do begin
@ -1501,13 +1512,16 @@ const
Move(Prefix[1],aName[1],PrefixLen); Move(Prefix[1],aName[1],PrefixLen);
if Len>0 then if Len>0 then
Move(p^,aName[PrefixLen+1],Len); Move(p^,aName[PrefixLen+1],Len);
{$IFDEF VerboseParseFPCParameter}
debugln(['ParseFPCParameter.AddBooleanFlag p="',p,'" Len=',Len,' Prefix="',Prefix,'" Name="'+aName+'"']);
{$ENDIF}
inc(p,Len); inc(p,Len);
if p[1]='-' then begin if p^='-' then begin
Add(aName,'',fpkBoolean,[fpfUnset]); Add(aName,'',fpkBoolean,[fpfUnset]);
inc(p); inc(p);
end else begin end else begin
Add(aName,FPCParamEnabled,fpkBoolean); Add(aName,FPCParamEnabled,fpkBoolean);
if p[1]='+' then if p^='+' then
inc(p); inc(p);
end; end;
end; end;
@ -1526,6 +1540,10 @@ const
Opt, Opt2, p2: PChar; Opt, Opt2, p2: PChar;
aName: string; aName: string;
begin begin
if not (p[1] in AlphaNum) then begin
AddBooleanFlag(p,1,'');
exit;
end;
Option:=p^; Option:=p^;
inc(p); inc(p);
repeat repeat
@ -1608,6 +1626,9 @@ const
var var
p, p2: PChar; p, p2: PChar;
begin begin
{$IFDEF VerboseParseFPCParameter}
debugln(['ParseFPCParameter "',CmdLineParam,'"']);
{$ENDIF}
if CmdLineParam='' then exit; if CmdLineParam='' then exit;
p:=PChar(CmdLineParam); p:=PChar(CmdLineParam);
case p^ of case p^ of
@ -1617,31 +1638,36 @@ begin
case p^ of case p^ of
'a': ReadSequence(p); 'a': ReadSequence(p);
'C': ReadSequence(p,'a: c: f: F: h: p: P= s: T*'); 'C': ReadSequence(p,'a: c: f: F: h: p: P= s: T*');
'd': Add(p[1],'',fpkDefine); 'd': Add(copy(CmdLineParam,3,255),'',fpkDefine);
'D': 'D':
begin begin
inc(p); inc(p);
case p^ of case p^ of
'd','v': Add('D'+p^,p[1],fpkValue); 'd','v': Add('D'+p^,PChar(@p[1]),fpkValue);
else else
AddBooleanFlag(p,1,'D'); AddBooleanFlag(p,1,'D');
end; end;
end; end;
'e': Add('e',p[1],fpkValue); 'e': Add('e',PChar(@p[1]),fpkValue);
'F': 'F':
case p[1] of case p[1] of
'a','f','i','l','o','u': Add('Fa',p[2],fpkMultiValue); '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],p[2],fpkValue); '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); else AddBooleanFlag(p,2);
end; end;
'g': 'g':
begin 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); inc(p);
repeat repeat
case p^ of case p^ of
'o': 'o':
begin begin
AddBooleanFlag(p,1,'g'); Add('g'+p,FPCParamEnabled,fpkBoolean,[]);
exit; exit;
end; end;
'w': 'w':
@ -1663,10 +1689,10 @@ begin
until false; until false;
end; end;
'i': ReadSequence(p,'S* T*'); 'i': ReadSequence(p,'S* T*');
'I': Add(p^,p[1],fpkMultiValue); 'I': Add(p^,PChar(@p[1]),fpkMultiValue);
'k': Add(p^,p[1],fpkMultiValue); 'k': Add(p^,PChar(@p[1]),fpkMultiValue);
'M': Add(p^,p[1],fpkValue); 'M': Add(p^,PChar(@p[1]),fpkValue);
'o': Add(p^,p[1],fpkValue); 'o': Add(p^,PChar(@p[1]),fpkValue);
'O': 'O':
case p[1] of case p[1] of
'-': DisableAllFlags('O'); '-': DisableAllFlags('O');
@ -1674,13 +1700,14 @@ begin
ReadSequence(p,'a= o* p: W:'); ReadSequence(p,'a= o* p: W:');
end; end;
'P': ; // ToDo 'P': ; // ToDo
'R': Add(p^,p[1],fpkValue); 'R': Add(p^,PChar(@p[1]),fpkValue);
'S': ReadSequence(p,'e: I:'); 'S': ReadSequence(p,'e: I:');
'T': Add(p^,p[1],fpkValue); 's': ReadSequence(p);
'u': Add(p[1],'',fpkDefine,[fpfUnset]); 'T': Add(p^,PChar(@p[1]),fpkValue);
'u': Add(copy(CmdLineParam,3,255),'',fpkDefine,[fpfUnset]);
'U': ReadSequence(p); 'U': ReadSequence(p);
'v': ReadSequence(p,'m&'); 'v': ReadSequence(p,'m&');
'V': Add(p^,p[1],fpkValue); 'V': Add(p^,PChar(@p[1]),fpkValue);
'W': ReadSequence(p,'B: M: P:'); 'W': ReadSequence(p,'B: M: P:');
'X': ReadSequence(p,'LA LO LD M: P: r: R:'); 'X': ReadSequence(p,'LA LO LD M: P: r: R:');
else else
@ -1690,13 +1717,57 @@ begin
end; end;
end; end;
'@': // config '@': // config
Add('',p[1],fpkConfig); Add('',PChar(@p[1]),fpkConfig);
else else
// filename // filename
Add('',p,fpkNonOption); Add('',p,fpkNonOption);
end; end;
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 function ReadNextFPCParameter(const CmdLine: string; var Position: integer; out
StartPos: integer): boolean; StartPos: integer): boolean;
// reads till start of next FPC command line parameter, parses quotes ' and " // reads till start of next FPC command line parameter, parses quotes ' and "

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

@ -22,7 +22,8 @@ unit TestBasicCodetools;
interface interface
uses uses
fpcunit, Classes, SysUtils, testglobals, FileProcs, BasicCodeTools, SourceLog; fpcunit, contnrs, Classes, SysUtils, testglobals, FileProcs, BasicCodeTools,
SourceLog;
type type
{ TTestBasicCodeTools } { TTestBasicCodeTools }
@ -44,6 +45,7 @@ type
procedure TestDateToCfgStr; procedure TestDateToCfgStr;
procedure TestFilenameIsMatching; procedure TestFilenameIsMatching;
procedure TestExtractFileUnitname; procedure TestExtractFileUnitname;
procedure TestParseFPCParameters;
// SourceLog // SourceLog
procedure TestChangeLineEndings; procedure TestChangeLineEndings;
end; end;
@ -437,6 +439,84 @@ begin
t('ab.c.d.pas',false,'d'); t('ab.c.d.pas',false,'d');
end; end;
procedure TTestBasicCodeTools.TestParseFPCParameters;
var
Parsed: TObjectList;
procedure Init(CmdLineParams: string);
begin
Parsed.Clear;
ParseFPCParameters(CmdLineParams,Parsed);
end;
procedure T(Params: string; ExpectedName, ExpectedValue: string;
ExpectedKind: TFPCParamKind; ExpectedFlags: TFPCParamFlags);
var
Actual: TFPCParamValue;
begin
Init(Params);
Actual:=GetFPCParamValue(Parsed,ExpectedName);
AssertNotNull('Param "'+ExpectedName+'" not found in "'+Params+'"',Actual);
AssertEquals('Params="'+Params+'" Param="'+ExpectedName+'" Value mismatch',ExpectedValue,Actual.Value);
AssertEquals('Params="'+Params+'" Param="'+ExpectedName+'" Kind mismatch',dbgs(ExpectedKind),dbgs(Actual.Kind));
AssertEquals('Params="'+Params+'" Param="'+ExpectedName+'" Flags mismatch',dbgs(ExpectedFlags),dbgs(Actual.Flags));
end;
begin
Parsed:=TObjectList.Create(true);
try
t('-a','a',FPCParamEnabled,fpkBoolean,[]);
t('-al','al',FPCParamEnabled,fpkBoolean,[]);
t('-aln','an',FPCParamEnabled,fpkBoolean,[]);
t('-al-n','al','',fpkBoolean,[fpfUnset]);
t('-al+l-n','al','',fpkBoolean,[fpfUnset,fpfSetTwice,fpfValueChanged]);
t('-al-ln','al',FPCParamEnabled,fpkBoolean,[fpfSetTwice,fpfValueChanged]);
t('-Adefault','Adefault',FPCParamEnabled,fpkBoolean,[]);
t('-b-','b','',fpkBoolean,[fpfUnset]);
t('-bl','bl',FPCParamEnabled,fpkBoolean,[]);
t('-C3','C3',FPCParamEnabled,fpkBoolean,[]);
t('-Cavalue','Ca','value',fpkValue,[]);
t('-CPPACKSET=4','CPPACKSET','4',fpkValue,[]);
t('-CrRt','CR',FPCParamEnabled,fpkBoolean,[]);
t('-dMacro','Macro','',fpkDefine,[]);
t('-Dddesc','Dd','desc',fpkValue,[]);
t('-epath','e','path',fpkValue,[]);
t('-E','E',FPCParamEnabled,fpkBoolean,[]);
t('-fPIC','fPIC',FPCParamEnabled,fpkBoolean,[]);
t('-Fabla','Fa','bla',fpkMultiValue,[]);
t('-g','g',FPCParamEnabled,fpkBoolean,[]);
t('-gchl','gh',FPCParamEnabled,fpkBoolean,[]);
t('-goset','goset',FPCParamEnabled,fpkBoolean,[]);
t('-gw2','gw','2',fpkValue,[]);
t('-iD','iD',FPCParamEnabled,fpkBoolean,[]);
t('-iSO','iSO',FPCParamEnabled,fpkBoolean,[]);
t('-kbla','k','bla',fpkMultiValue,[]);
t('-l-','l','',fpkBoolean,[fpfUnset]);
t('-Mdelphi','M','delphi',fpkValue,[]);
t('-n-','n','',fpkBoolean,[fpfUnset]);
t('-opath','o','path',fpkValue,[]);
t('-O2','O2',FPCParamEnabled,fpkBoolean,[]);
t('-Oab=c','Oab','c',fpkValue,[]);
t('-pg','pg',FPCParamEnabled,fpkBoolean,[]);
t('-Rfoo','R','foo',fpkValue,[]);
t('-S2','S2',FPCParamEnabled,fpkBoolean,[]);
t('-Sefoo','Se','foo',fpkValue,[]);
t('-s','s',FPCParamEnabled,fpkBoolean,[]);
t('-sht-','st','',fpkBoolean,[fpfUnset]);
t('-Tfoo','T','foo',fpkValue,[]);
t('-uMacro','Macro','',fpkDefine,[fpfUnset]);
t('-dMacro -uMacro','Macro','',fpkDefine,[fpfUnset,fpfSetTwice,fpfValueChanged]);
t('-Uns-','Us','',fpkBoolean,[fpfUnset]);
t('-vwne','ve',FPCParamEnabled,fpkBoolean,[]);
t('-vmfoo','vm','foo',fpkMultiValue,[]);
t('-Wbe','We',FPCParamEnabled,fpkBoolean,[]);
t('-WMfoo','WM','foo',fpkValue,[]);
t('-X9LA-LO-','XLO','',fpkBoolean,[fpfUnset]);
finally
Parsed.Free;
end;
end;
procedure TTestBasicCodeTools.TestChangeLineEndings; procedure TTestBasicCodeTools.TestChangeLineEndings;
procedure t(s, NewLineEnding, Expected: string); procedure t(s, NewLineEnding, Expected: string);