diff --git a/components/codetools/definetemplates.pas b/components/codetools/definetemplates.pas index a60c5d97c2..11faae163a 100644 --- a/components/codetools/definetemplates.pas +++ b/components/codetools/definetemplates.pas @@ -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; diff --git a/components/codetools/fileprocs.pas b/components/codetools/fileprocs.pas index 123fb6e963..97482c7a00 100644 --- a/components/codetools/fileprocs.pas +++ b/components/codetools/fileprocs.pas @@ -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;