mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-09 00:08:12 +02:00
499 lines
12 KiB
ObjectPascal
499 lines
12 KiB
ObjectPascal
unit rewritemakefile;
|
|
|
|
{$mode ObjFPC}{$H+}
|
|
|
|
interface
|
|
|
|
uses strutils, regexpr, sysutils, classes, types, prefixer;
|
|
|
|
Type
|
|
|
|
{ TRewriteMakeFile }
|
|
TMakeFileToolLogEvent = procedure(Sender : TObject; EventType : TEventType; Const Msg : String) of object;
|
|
|
|
TRewriteMakeFile = Class(TComponent)
|
|
private
|
|
FAliasesFileName: String;
|
|
FNew,
|
|
FCommon,
|
|
FNames,
|
|
FSkip,
|
|
FAliases : TStrings;
|
|
FOnLog: TMakeFileToolLogEvent;
|
|
FCommonUnitsFileName: String;
|
|
FSkipUnitsFileName: String;
|
|
|
|
procedure SetAliasesFileName(AValue: String);
|
|
procedure SetCommonUnitsFileName(AValue: String);
|
|
procedure SetSkipUnitsFileName(AValue: String);
|
|
Protected
|
|
procedure DoMsg(const aFmt: String; const aArgs: array of const;
|
|
EventType: TEventType=etInfo); overload;
|
|
procedure DoMsg(const aMessage: String; EventType: TEventType=etInfo); overload;
|
|
|
|
procedure LoadNames(const aFileName: String; aAliases, aNames: TStrings); virtual;
|
|
procedure addRecipe(aRecipe: TStrings); virtual;
|
|
function GetNextLine(aLines: TStrings; var I: integer; var aLine: String): Boolean;
|
|
function GetDottedUnitSrc(const aUnit,DottedUnit, aExt : String) : String; virtual;
|
|
Public
|
|
class function ExtractSourceExt(aLine, aUnit: string): String;
|
|
class function ReplaceSourceFile(aLine, aUnit: string): String;
|
|
class function CheckContinue(aLine: String): Boolean;
|
|
class function CorrectSpaces(S: String; aIndent: String): string;
|
|
class procedure FixTabs(sl: TStrings);
|
|
class function IsRule(aLine: String): Boolean;
|
|
class function ReplaceUnits(const aLine: string; aUnitNames: TStrings): String;
|
|
class function ReplaceWord(aLine, aName, aFull: String): String;
|
|
class function StripMacroChars(S: String): String;
|
|
Public
|
|
Constructor Create(aOwner : TComponent); override;
|
|
Destructor Destroy; override;
|
|
procedure HandleMakeFile(aFileName: string);
|
|
Property AliasesFileName : String Read FAliasesFileName Write SetAliasesFileName;
|
|
Property CommonUnitsFileName : String Read FCommonUnitsFileName Write SetCommonUnitsFileName;
|
|
Property SkipUnitsFileName : String Read FSkipUnitsFileName Write SetSkipUnitsFileName;
|
|
Property OnLog : TMakeFileToolLogEvent Read FOnLog Write FOnLog;
|
|
end;
|
|
|
|
Implementation
|
|
|
|
class function TRewriteMakeFile.ReplaceWord(aLine, aName, aFull: String): String;
|
|
|
|
var
|
|
RE : TRegExpr;
|
|
|
|
begin
|
|
RE:=TRegExpr.Create('\b'+aName+'\b');
|
|
try
|
|
RE.ModifierI:=True;
|
|
Result:=RE.Replace(aLine,aFull);
|
|
// Writeln(aLine,': ',aName,' -> ',aFull,' = ',Result);
|
|
finally
|
|
RE.Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
class function TRewriteMakeFile.ReplaceUnits(const aLine: string; aUnitNames: TStrings): String;
|
|
|
|
Var
|
|
res,aName,aFull : String;
|
|
|
|
begin
|
|
Res:=aLine;
|
|
for aName in aUnitNames do
|
|
begin
|
|
aFull:='$('+UpperCase(aName)+'UNIT)';
|
|
Res:=ReplaceWord(Res,aName,aFull);
|
|
end;
|
|
Result:=Res;
|
|
end;
|
|
|
|
procedure TRewriteMakeFile.SetAliasesFileName(AValue: String);
|
|
begin
|
|
if FAliasesFileName=AValue then Exit;
|
|
FAliasesFileName:=AValue;
|
|
if aValue='' then
|
|
FAliases.Clear;
|
|
FNames.Clear;
|
|
LoadNames(aValue,FAliases,FNames);
|
|
end;
|
|
|
|
procedure TRewriteMakeFile.SetCommonUnitsFileName(AValue: String);
|
|
begin
|
|
if FCommonUnitsFileName=AValue then Exit;
|
|
FCommonUnitsFileName:=AValue;
|
|
if aValue='' then
|
|
FCommon.Clear
|
|
else
|
|
FCommon.LoadFromFile(aValue);
|
|
end;
|
|
|
|
procedure TRewriteMakeFile.SetSkipUnitsFileName(AValue: String);
|
|
begin
|
|
if FSkipUnitsFileName=AValue then Exit;
|
|
FSkipUnitsFileName:=AValue;
|
|
if aValue='' then
|
|
FSkip.Clear
|
|
else
|
|
FSkip.LoadFromFile(aValue);
|
|
end;
|
|
|
|
procedure TRewriteMakeFile.DoMsg(const aFmt: String;
|
|
const aArgs: array of const; EventType: TEventType);
|
|
|
|
begin
|
|
DoMsg(Format(aFmt,aArgs),EventType);
|
|
end;
|
|
|
|
procedure TRewriteMakeFile.DoMsg(const aMessage: String; EventType: TEventType);
|
|
begin
|
|
if assigned(OnLog) then
|
|
OnLog(Self,EventType, aMessage);
|
|
end;
|
|
|
|
procedure TRewriteMakeFile.LoadNames(const aFileName: String; aAliases,
|
|
aNames: TStrings);
|
|
|
|
var
|
|
I : integer;
|
|
N,V : String;
|
|
|
|
begin
|
|
aAliases.LoadFromFile(aFileName);
|
|
for I:=0 to aAliases.Count-1 do
|
|
begin
|
|
aAliases.GetNameValue(I,N,V);
|
|
if SameText(N,'unixcp') then
|
|
Writeln('Aloha');
|
|
aAliases[I]:=N+'='+TPrefixer.ApplyAliasRule(N,V);
|
|
aNames.Add(N);
|
|
end;
|
|
end;
|
|
|
|
class function TRewriteMakeFile.CheckContinue(aLine: String): Boolean;
|
|
|
|
Var
|
|
L : Integer;
|
|
|
|
begin
|
|
L:=Length(aLine);
|
|
Result:=(L>0) and (aLine[L]='\');
|
|
end;
|
|
|
|
class function TRewriteMakeFile.IsRule(aLine: String): Boolean;
|
|
|
|
begin
|
|
Result:=(aLine='') or (aLine[1]=#9)
|
|
end;
|
|
|
|
function TRewriteMakeFile.GetNextLine(aLines: TStrings; var I: integer;
|
|
var aLine: String): Boolean;
|
|
|
|
begin
|
|
Result:=I<aLines.Count-1;
|
|
if Result then
|
|
begin
|
|
Inc(I);
|
|
aLine:=aLines[i];
|
|
end;
|
|
end;
|
|
|
|
function TRewriteMakeFile.GetDottedUnitSrc(const aUnit, DottedUnit, aExt: String
|
|
): String;
|
|
begin
|
|
if FCommon.IndexOf(aUnit)=-1 then
|
|
Result:='$(NSOSDIR)/'
|
|
else
|
|
Result:='$(NSINC)/';
|
|
Result:=Result+DottedUnit+aExt
|
|
end;
|
|
|
|
class function TRewriteMakeFile.ReplaceSourceFile(aLine, aUnit: string): String;
|
|
|
|
Procedure AddToResult(S: String);
|
|
|
|
begin
|
|
if Result<>'' then
|
|
Result:=Result+' ';
|
|
Result:=Result+S;
|
|
end;
|
|
|
|
Function ReplacePath(S : String) : String;
|
|
|
|
begin
|
|
if pos(aUnit+'.pp',S)>0 then
|
|
Result:='$<'
|
|
else if pos(aUnit+'.pas',S)>0 then
|
|
Result:='$<'
|
|
else
|
|
Result:=S;
|
|
end;
|
|
|
|
Var
|
|
a : Array of string;
|
|
S : String;
|
|
|
|
begin
|
|
Result:='';
|
|
A:=SplitString(aLine,' ');
|
|
For S in a do
|
|
begin
|
|
if Pos(aUnit,S)=0 then
|
|
AddToResult(S)
|
|
else
|
|
AddToResult(ReplacePath(S));
|
|
end;
|
|
end;
|
|
|
|
class function TRewriteMakeFile.StripMacroChars(S: String): String;
|
|
|
|
begin
|
|
if Pos('$(',S)=0 then
|
|
Result:=S
|
|
else
|
|
begin
|
|
Result:=StringReplace(S,'$(','',[]);
|
|
Result:=StringReplace(Result,')','',[]);
|
|
end;
|
|
end;
|
|
|
|
constructor TRewriteMakeFile.Create(aOwner: TComponent);
|
|
begin
|
|
inherited Create(aOwner);
|
|
FAliases:=TStringList.Create;
|
|
FNames:=TStringList.Create;
|
|
FCommon:=TStringList.Create;
|
|
FNew:=TStringList.Create;
|
|
FSkip:=TStringList.Create;
|
|
end;
|
|
|
|
destructor TRewriteMakeFile.Destroy;
|
|
begin
|
|
FreeAndNil(FSkip);
|
|
FreeAndNil(FNew);
|
|
FreeAndNil(FAliases);
|
|
FreeAndNil(FNames);
|
|
FreeAndNil(FCommon);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
class function TRewriteMakeFile.CorrectSpaces(S: String; aIndent: String
|
|
): string;
|
|
|
|
var
|
|
len,aCount : Integer;
|
|
|
|
begin
|
|
aCount:=0;
|
|
len:=Length(aIndent);
|
|
While (aCount<Length(S)) and (S[aCount+1]=' ') do
|
|
inc(aCount);
|
|
Result:=S;
|
|
if aCount<Len then
|
|
Result:=Copy(aIndent,1,Len-aCount)+Result
|
|
else if aCount>Len then
|
|
Delete(Result,1,aCount-Len);
|
|
end;
|
|
|
|
class function TRewriteMakeFile.ExtractSourceExt(aLine, aUnit: string): String;
|
|
|
|
Var
|
|
a : Array of string;
|
|
S : String;
|
|
|
|
begin
|
|
Result:='';
|
|
A:=SplitString(aLine,' ');
|
|
For S in a do
|
|
begin
|
|
if Pos(aUnit,S)<>0 then
|
|
begin
|
|
Result:=ExtractFileExt(S);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TRewriteMakeFile.addRecipe(aRecipe: TStrings);
|
|
|
|
var
|
|
aTarget, aCompileLine, aExt, aUnit, aDottedUnit, aCasedUnit, aLine,aDeps,aUpper,aIndent,UnitDeps : String;
|
|
P,NameIdx,Idx,I,iRules : Integer;
|
|
|
|
begin
|
|
aLine:=aRecipe[0];
|
|
P:=Pos('$(PPUEXT)',aLine);
|
|
aUnit:=Trim(Copy(aLine,1,P-1));
|
|
if FSkip.IndexOf(aUnit)<>-1 then
|
|
begin
|
|
DoMsg('Skipping unit "%s"',[aUnit],etWarning);
|
|
Exit;
|
|
end;
|
|
NameIdx:=FNames.IndexOf(aUnit);
|
|
if NameIdx<>-1 then
|
|
FNames.Delete(NameIdx);
|
|
|
|
P:=Pos(':',aLine);
|
|
aTarget:=Copy(aLine,1,P);
|
|
aDeps:=Copy(aLine,P+1);
|
|
aUpper:=UpperCase(aUnit);
|
|
UnitDeps:=StripMacroChars(aUpper)+'_DEPS';
|
|
FNew.Add('');
|
|
aExt:=ExtractSourceExt(aDeps,aUnit);
|
|
aDeps:=UNITDEPS+'='+Trim(ReplaceUnits(aDeps,FNames));
|
|
if aDeps[Length(aDeps)]<>'\' then
|
|
aDeps:=aDeps+'\';
|
|
FNew.Add(aDeps);
|
|
aIndent:=StringOfChar(' ',Length(UnitDeps)+1);
|
|
i:=0;
|
|
While CheckContinue(aLine) and GetNextLine(aRecipe,I,aLine) do
|
|
begin
|
|
if aExt='' then
|
|
aExt:=ExtractSourceExt(aDeps,aUnit);
|
|
aDeps:=CorrectSpaces(ReplaceUnits(aLine,FNames),aIndent);
|
|
if aDeps[Length(aDeps)]<>'\' then
|
|
aDeps:=aDeps+'\';
|
|
FNew.Add(aDeps);
|
|
end;
|
|
FNew.Add(aIndent+'$('+UnitDeps+'_OS) '+'$('+UnitDeps+'_CPU)');
|
|
FNew.Add('');
|
|
FNew.Add(aTarget+' $('+UnitDeps+')');
|
|
iRules:=I;
|
|
While GetNextLine(aRecipe,I,aLine) and IsRule(aLine) do
|
|
begin
|
|
aCompileLine:=ReplaceSourceFile(aLine,aUnit);
|
|
FNew.Add(ReplaceUnits(aCompileLine,FNames));
|
|
end;
|
|
Idx:=FAliases.IndexOfName(aUnit);
|
|
if Idx<>-1 then
|
|
begin
|
|
FAliases.GetNameValue(Idx,aCasedUnit,aDottedunit);
|
|
aTarget:=StringReplace(aTarget,aUnit,aDottedUnit,[]);
|
|
FNew.Add('');
|
|
FNew.Add(aTarget+' '+GetDottedUnitSrc(aUnit,aDottedUnit,aExt)+' $('+UnitDeps+')');
|
|
I:=iRules;
|
|
While GetNextLine(aRecipe,I,aLine) and IsRule(aLine) do
|
|
begin
|
|
aCompileLine:=ReplaceSourceFile(aLine,aUnit);
|
|
FNew.Add(ReplaceUnits(aCompileLine,FNames));
|
|
end;
|
|
end;
|
|
if NameIdx<>-1 then
|
|
FNames.Insert(NameIdx,aUnit);
|
|
end;
|
|
|
|
class procedure TRewriteMakeFile.FixTabs(sl:TStrings);
|
|
var
|
|
i,j,k : integer;
|
|
s,s2 : string;
|
|
isContinue : Boolean;
|
|
begin
|
|
isContinue:=False;
|
|
i:=0;
|
|
while (i<sl.Count) do
|
|
begin
|
|
s:=sl[i];
|
|
if Not IsContinue then
|
|
begin
|
|
if (s<>'') and (s[1] in [' ',#9]) then
|
|
begin
|
|
k:=0;
|
|
j:=0;
|
|
repeat
|
|
inc(j);
|
|
case s[j] of
|
|
' ' :
|
|
inc(k);
|
|
#9 :
|
|
k:=(k+7) and not(7);
|
|
else
|
|
break;
|
|
end;
|
|
until (j=length(s));
|
|
if k>7 then
|
|
begin
|
|
s2:='';
|
|
Delete(s,1,j-1);
|
|
while (k>7) do
|
|
begin
|
|
s2:=s2+#9;
|
|
dec(k,8);
|
|
end;
|
|
while (k>0) do
|
|
begin
|
|
s2:=s2+' ';
|
|
dec(k);
|
|
end;
|
|
sl[i]:=s2+s;
|
|
end;
|
|
end;
|
|
end;
|
|
IsContinue:=(S<>'') and (S[Length(S)]='\');
|
|
inc(i);
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
procedure TRewriteMakeFile.HandleMakeFile(aFileName: string);
|
|
|
|
Var
|
|
aMakeFile : TStrings;
|
|
|
|
Function DoGetNextLine(var I : integer; var aLine : String) : Boolean;
|
|
|
|
begin
|
|
Result:=GetNextLine(aMakeFile,I,aLine);
|
|
end;
|
|
|
|
var
|
|
i,P : Integer;
|
|
aRecipe : TStrings;
|
|
aSection,aLine : String;
|
|
|
|
begin
|
|
aLine:='';
|
|
aRecipe:=Nil;
|
|
aMakeFile:=TStringList.Create;
|
|
try
|
|
aRecipe:=TstringList.Create;
|
|
aMakeFile.LoadFromFile(aFileName);
|
|
FixTabs(aMakeFile);
|
|
I:=-1;
|
|
While DoGetNextLine(I,aLine) do
|
|
begin
|
|
aLine:=aMakefile[I];
|
|
if Copy(aLine,1,1)='[' then
|
|
aSection:=LowerCase(Copy(aLine,2,Length(aLine)-2));
|
|
Case asection of
|
|
'rules',
|
|
'prerules' :
|
|
begin
|
|
P:=Pos('$(PPUEXT)',aLine);
|
|
if (P>0) and (Pos(':',aLine)>P) then
|
|
begin
|
|
aRecipe.Clear;
|
|
aRecipe.Add(aLine);
|
|
// Add continuation lines
|
|
While CheckContinue(aLine) and DoGetNextLine(I,aLine) do
|
|
aRecipe.Add(aLine);
|
|
// Add compiler rules
|
|
While DoGetNextLine(I,aLine) and (IsRule(aLine)) do
|
|
aRecipe.add(aLine);
|
|
addRecipe(aRecipe);
|
|
Dec(I); // Go back to previous line.
|
|
end
|
|
else
|
|
FNew.Add(aLine);
|
|
end;
|
|
'shared',
|
|
'target':
|
|
begin
|
|
P:=Pos('=',aLine);
|
|
if (P>0) and (IndexText(Trim(Copy(aLine,1,P-1)),['units','implicitunits','libunits'])<>-1) then
|
|
begin
|
|
FNew.Add(ReplaceUnits(aLine,FNames));
|
|
While CheckContinue(aLine) and DoGetNextLine(I,aLine) do
|
|
FNew.Add(ReplaceUnits(aLine,FNames));
|
|
end
|
|
else
|
|
FNew.Add(aLine);
|
|
end;
|
|
else
|
|
FNew.Add(aLine);
|
|
end;
|
|
end;
|
|
// ReplaceUnits(aMakefile[I],aNames);
|
|
FNew.SaveToFile(aFileName+'.new');
|
|
finally
|
|
aMakeFile.Free;
|
|
aRecipe.Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
end.
|
|
|