mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-12-16 06:10:34 +01:00
* Interdependency reduction, verbosity introduced
git-svn-id: trunk@22214 -
This commit is contained in:
michael
parent
b9fa9da629
commit
88776524fd
@ -10,6 +10,49 @@ uses
|
||||
|
||||
type
|
||||
|
||||
{ TUnitEntry }
|
||||
|
||||
TUnitEntry = Class(TCollectionItem)
|
||||
private
|
||||
FIntfDeps: TStrings;
|
||||
FImplDeps: TStrings;
|
||||
FDone: Boolean;
|
||||
FErr: String;
|
||||
FFileName : String;
|
||||
FName: String;
|
||||
FProcessing: Boolean;
|
||||
Fres: Boolean;
|
||||
function GetName: String;
|
||||
Public
|
||||
constructor Create(ACollection: TCollection); override;
|
||||
destructor Destroy; override;
|
||||
Procedure CleanIntfDependencies(Verbose : Boolean);
|
||||
Procedure CleanImplDependencies(Verbose : Boolean);
|
||||
Procedure OrderDependencies(Order : TStrings);
|
||||
Function Nodependencies : Boolean;
|
||||
Property FileName : String Read FFileName Write FFileName;
|
||||
Property Name : String Read GetName;
|
||||
Property IntfDependencies : TStrings Read FIntfDeps;
|
||||
Property ImplDependencies : TStrings Read FImplDeps;
|
||||
Property Resources : Boolean Read Fres Write Fres;
|
||||
Property Err : String Read FErr Write Ferr;
|
||||
Property Done : Boolean Read FDone Write FDone;
|
||||
Property Processing : Boolean Read FProcessing Write FProcessing;
|
||||
end;
|
||||
|
||||
{ TUnitEntries }
|
||||
|
||||
TUnitEntries = Class(TCollection)
|
||||
private
|
||||
function GetE(AIndex : Integer): TUnitEntry;
|
||||
public
|
||||
Function IndexOfEntry(Const AName : String) : Integer;
|
||||
Function FindEntry(Const AName : string) : TUnitEntry;
|
||||
Function AddEntry(Const AFileName : String) : TUnitEntry;
|
||||
Property Units[AIndex : Integer] : TUnitEntry Read GetE; default;
|
||||
end;
|
||||
|
||||
|
||||
{ TPas2FPMakeApp }
|
||||
|
||||
TPas2FPMakeApp = class(TCustomApplication)
|
||||
@ -17,12 +60,15 @@ type
|
||||
procedure AddLine(const ALine: String);
|
||||
function CheckParams : boolean;
|
||||
procedure CreateSources;
|
||||
function GetUnitProps(const FN: String; out Res: Boolean; U: TStrings; Out Err : string): Boolean;
|
||||
Procedure ProcessUnits;
|
||||
function GetUnitProps(const FN: String; out Res: Boolean; UIn,UIm: TStrings; Out Err : string): Boolean;
|
||||
Function SimulateCompile(E,EFrom: TUnitEntry) : Boolean;
|
||||
procedure WriteProgEnd;
|
||||
procedure WriteProgStart;
|
||||
procedure WriteSources;
|
||||
protected
|
||||
FFiles,
|
||||
FVerbose : Boolean;
|
||||
FFiles : TUnitEntries;
|
||||
FSrc,
|
||||
FUnits: TStrings;
|
||||
InterfaceUnitsOnly : Boolean;
|
||||
@ -35,6 +81,138 @@ type
|
||||
procedure WriteHelp; virtual;
|
||||
end;
|
||||
|
||||
{ TUnitEntries }
|
||||
|
||||
function TUnitEntries.GetE(AIndex : Integer): TUnitEntry;
|
||||
begin
|
||||
Result:=Items[AIndex] as TUnitEntry;
|
||||
end;
|
||||
|
||||
function TUnitEntries.IndexOfEntry(const AName: String): Integer;
|
||||
begin
|
||||
Result:=Count-1;
|
||||
While (Result>=0) and (CompareText(GetE(Result).Name,AName)<>0) do
|
||||
Dec(Result);
|
||||
end;
|
||||
|
||||
function TUnitEntries.FindEntry(const AName: string): TUnitEntry;
|
||||
|
||||
Var
|
||||
I:Integer;
|
||||
begin
|
||||
I:=IndexofEntry(Aname);
|
||||
If (I<>-1) then
|
||||
Result:=GetE(I)
|
||||
else
|
||||
Result:=Nil;
|
||||
end;
|
||||
|
||||
function TUnitEntries.AddEntry(Const AFileName: String): TUnitEntry;
|
||||
begin
|
||||
Result:=Add as TunitEntry;
|
||||
Result.FileName:=AFileName;
|
||||
end;
|
||||
|
||||
{ TUnitEntry }
|
||||
|
||||
function TUnitEntry.GetName: String;
|
||||
begin
|
||||
Result:=ChangeFileExt(ExtractFileName(FileName),'');
|
||||
end;
|
||||
|
||||
constructor TUnitEntry.Create(ACollection: TCollection);
|
||||
begin
|
||||
inherited Create(ACollection);
|
||||
FIntfDeps:=TStringList.Create;
|
||||
FImplDeps:=TStringList.Create;
|
||||
end;
|
||||
|
||||
destructor TUnitEntry.Destroy;
|
||||
begin
|
||||
FreeAndNil(FIntfDeps);
|
||||
FreeAndNil(FImplDeps);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TUnitEntry.CleanIntfDependencies(Verbose : Boolean);
|
||||
|
||||
Var
|
||||
I,J : Integer;
|
||||
U : TUnitEntry;
|
||||
|
||||
begin
|
||||
For I:=FintfDeps.Count-1 downto 0 do
|
||||
begin
|
||||
U:=FIntfDeps.Objects[i] as TUnitEntry;
|
||||
J:=U.ImplDependencies.IndexOf(Name);
|
||||
if J<>-1 then
|
||||
begin
|
||||
U.ImplDependencies.Delete(J);
|
||||
If Verbose then
|
||||
Writeln(StdErr,'Removing interdependency of ',Name,' from ',U.Name);
|
||||
end;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
procedure TUnitEntry.CleanImplDependencies(Verbose : Boolean);
|
||||
|
||||
Var
|
||||
I,J : Integer;
|
||||
U : TUnitEntry;
|
||||
|
||||
begin
|
||||
For I:=FImplDeps.Count-1 downto 0 do
|
||||
begin
|
||||
U:=FImplDeps.Objects[i] as TUnitEntry;
|
||||
J:=U.ImplDependencies.IndexOf(Name);
|
||||
if J<>-1 then
|
||||
begin
|
||||
U.ImplDependencies.Delete(J);
|
||||
If Verbose then
|
||||
Writeln(StdErr,'Removing interdependency of ',Name,' from ',U.Name);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TUnitEntry.OrderDependencies(Order: TStrings);
|
||||
|
||||
Var
|
||||
L : TStringList;
|
||||
I,CC : integer;
|
||||
|
||||
begin
|
||||
L:=TstringList.Create;
|
||||
try
|
||||
L.Assign(FintfDeps);
|
||||
L.Sorted:=True;
|
||||
CC:=L.Count;
|
||||
FintfDeps.Clear;
|
||||
For I:=0 to Order.Count-1 do
|
||||
if L.Indexof(Order[i])<>-1 then
|
||||
FIntfDeps.Add(Order[i]);
|
||||
If FintfDeps.Count<>CC then
|
||||
Writeln('Internal error 1');
|
||||
L.Sorted:=False;
|
||||
L.Assign(FimplDeps);
|
||||
CC:=L.Count;
|
||||
L.Sorted:=True;
|
||||
FImplDeps.Clear;
|
||||
For I:=0 to Order.Count-1 do
|
||||
if L.Indexof(Order[i])<>-1 then
|
||||
FImplDeps.Add(Order[i]);
|
||||
If FImplDeps.Count<>CC then
|
||||
Writeln('Internal error 2');
|
||||
finally
|
||||
L.free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TUnitEntry.Nodependencies: Boolean;
|
||||
begin
|
||||
Result:=(FIntfDeps.Count=0) and (FImplDeps.Count=0);
|
||||
end;
|
||||
|
||||
{ TPas2FPMakeApp }
|
||||
|
||||
Function TPas2FPMakeApp.CheckParams : Boolean;
|
||||
@ -50,7 +228,8 @@ Function TPas2FPMakeApp.CheckParams : Boolean;
|
||||
If FindFirst(S,0,Info)=0 then
|
||||
try
|
||||
Repeat
|
||||
FFiles.Add(D+Info.Name);
|
||||
FFiles.AddEntry(D+Info.Name);
|
||||
FUnits.Add(ChangeFileExt(ExtractFileName(info.name),''));
|
||||
until (FindNext(Info)<>0);
|
||||
finally
|
||||
FindClose(Info);
|
||||
@ -75,7 +254,7 @@ begin
|
||||
AddFileMask(S)
|
||||
else if comparetext(ChangeFileExt(extractfilename(s),''),'fpmake')<>0 then
|
||||
begin
|
||||
FFiles.Add(S);
|
||||
FFiles.AddEntry(S);
|
||||
FUnits.Add(ChangeFileExt(ExtractFileName(S),''));
|
||||
end;
|
||||
end
|
||||
@ -88,6 +267,8 @@ begin
|
||||
end
|
||||
else If (s='-i') then
|
||||
InterfaceUnitsOnly:=True
|
||||
else If (s='-v') then
|
||||
FVerbose:=True
|
||||
else if (s='-p') then
|
||||
begin
|
||||
Inc(i);
|
||||
@ -111,26 +292,40 @@ begin
|
||||
FSrc.Add(ALine);
|
||||
end;
|
||||
|
||||
Function TPas2FPMakeApp.GetUnitProps(Const FN : String; Out Res : Boolean; U : TStrings; Out Err : string) : Boolean;
|
||||
Function TPas2FPMakeApp.GetUnitProps(Const FN : String; Out Res : Boolean; UIn,UIm : TStrings; Out Err : string) : Boolean;
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
I,J : Integer;
|
||||
A : TPasSrcAnalysis;
|
||||
|
||||
begin
|
||||
Result:=False;
|
||||
try
|
||||
If FVerbose then
|
||||
Writeln(StdErr,'Analysing unit ',FN);
|
||||
A:=TPasSrcAnalysis.Create(Self);
|
||||
try
|
||||
A.FileName:=FN;
|
||||
Res:=A.HasResourcestrings;
|
||||
if InterfaceUnitsOnly then
|
||||
A.GetInterfaceUnits(U)
|
||||
else
|
||||
A.GetUsedUnits(U);
|
||||
For I:=U.Count-1 downto 0 do
|
||||
if FUnits.IndexOf(U[i])=-1 then
|
||||
U.Delete(i);
|
||||
A.GetInterfaceUnits(Uin);
|
||||
if Not InterfaceUnitsOnly then
|
||||
A.GetImplementationUnits(Uim);
|
||||
For I:=Uin.Count-1 downto 0 do
|
||||
begin
|
||||
J:=FUnits.IndexOf(UIN[i]);
|
||||
if (j=-1) then
|
||||
Uin.Delete(i)
|
||||
else
|
||||
Uin.Objects[i]:=FUnits.Objects[J];
|
||||
end;
|
||||
For I:=Uim.Count-1 downto 0 do
|
||||
begin
|
||||
J:=FUnits.IndexOf(UIm[i]);
|
||||
if (j=-1) then
|
||||
Uim.Delete(i)
|
||||
else
|
||||
Uim.Objects[i]:=FUnits.Objects[J];
|
||||
end;
|
||||
finally
|
||||
A.Free;
|
||||
end;
|
||||
@ -181,35 +376,114 @@ procedure TPas2FPMakeApp.CreateSources;
|
||||
Var
|
||||
I,j : Integer;
|
||||
U : TStrings;
|
||||
FN,Err : String;
|
||||
R : Boolean;
|
||||
F : TUnitEntry;
|
||||
FN : String;
|
||||
|
||||
begin
|
||||
WriteProgStart;
|
||||
For I:=0 to FFiles.Count-1 do
|
||||
For I:=0 to FUnits.Count-1 do
|
||||
begin
|
||||
FN:=FFiles[i];
|
||||
F:=FFiles.FindEntry(FUnits[i]);
|
||||
FN:=F.FileName;
|
||||
AddLine(' T:=P.Targets.AddUnit('''+FN+''');');
|
||||
U:=TStringList.Create;
|
||||
if not GetUnitProps(Fn,R,U,Err) then
|
||||
AddLine(' // Failed to analyse unit "'+Fn+'". Error: "'+Err+'"')
|
||||
if F.Err<>'' then
|
||||
AddLine(' // Failed to analyse unit "'+Fn+'". Error: "'+F.Err+'"')
|
||||
else
|
||||
begin
|
||||
if R then
|
||||
if F.Resources then
|
||||
AddLine(' T.ResourceStrings := True;');
|
||||
if (U.Count>0) then
|
||||
begin
|
||||
AddLine(' with T.Dependencies do');
|
||||
AddLine(' begin');
|
||||
For J:=0 to U.Count-1 do
|
||||
AddLine(' AddUnit('''+U[j]+''');');
|
||||
AddLine(' end;');
|
||||
end;
|
||||
U:=TStringList.Create;
|
||||
try
|
||||
U.AddStrings(F.IntfDependencies);
|
||||
U.AddStrings(F.ImplDependencies);
|
||||
if (U.Count>0) then
|
||||
begin
|
||||
AddLine(' with T.Dependencies do');
|
||||
AddLine(' begin');
|
||||
For J:=0 to U.Count-1 do
|
||||
AddLine(' AddUnit('''+U[j]+''');');
|
||||
AddLine(' end;');
|
||||
end;
|
||||
finally
|
||||
U.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
WriteProgEnd;
|
||||
end;
|
||||
|
||||
function TPas2FPMakeApp.SimulateCompile(E,EFrom: TUnitEntry): Boolean;
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
Result:=True;
|
||||
if E.Done then
|
||||
begin
|
||||
Result:=Not E.Processing;
|
||||
if FVerbose then
|
||||
if Not Result then
|
||||
Writeln(StdErr,'Detected circular reference ',E.Name,' coming from ',EFrom.Name)
|
||||
else if Assigned(EFrom) then
|
||||
Writeln(StdErr,'Attempt to recompile ',E.Name,' coming from ',EFrom.Name)
|
||||
else
|
||||
Writeln(StdErr,'Attempt to recompile ',E.Name);
|
||||
exit;
|
||||
end;
|
||||
E.Done:=True;
|
||||
E.Processing:=True;
|
||||
For I:=0 to E.IntfDependencies.Count-1 do
|
||||
SimulateCompile(E.IntfDependencies.Objects[I] as TUnitEntry,E);
|
||||
For I:=0 to E.ImplDependencies.Count-1 do
|
||||
SimulateCompile(E.ImplDependencies.Objects[I] as TUnitEntry,E);
|
||||
E.Processing:=False;
|
||||
FUnits.Add(E.Name);
|
||||
end;
|
||||
|
||||
procedure TPas2FPMakeApp.ProcessUnits;
|
||||
|
||||
Var
|
||||
I,J,k : integer;
|
||||
Err : String;
|
||||
F : TUnitEntry;
|
||||
R : Boolean;
|
||||
|
||||
begin
|
||||
For I:=0 to Funits.Count-1 do
|
||||
begin
|
||||
J:=FFiles.IndexOfEntry(FUnits[i]);
|
||||
Funits.Objects[i]:=FFiles[J];
|
||||
end;
|
||||
TStringList(FUnits).Sorted:=True;
|
||||
For I:=0 to FFiles.Count-1 do
|
||||
begin
|
||||
F:=FFiles[i];
|
||||
if not GetUnitProps(F.FileName,R,F.IntfDependencies,F.ImplDependencies,Err) then
|
||||
F.Err:=Err
|
||||
else
|
||||
F.Resources:=R;
|
||||
end;
|
||||
For I:=0 to FFiles.Count-1 do
|
||||
FFiles[i].CleanIntfDependencies(FVerbose);
|
||||
For I:=0 to FFiles.Count-1 do
|
||||
FFiles[i].CleanImplDependencies(FVerbose);
|
||||
TStringList(FUnits).Sorted:=False;
|
||||
FUnits.Clear;
|
||||
For I:=0 to FFiles.Count-1 do
|
||||
if FFiles[i].NoDependencies then
|
||||
begin
|
||||
FUnits.Add(FFiles[i].Name);
|
||||
FFiles[i].Done:=True;
|
||||
end;
|
||||
For I:=0 to FFiles.Count-1 do
|
||||
SimulateCompile(FFiles[i],Nil);
|
||||
// At this point, FUnits is in the order that the compiler should compile them.
|
||||
// Now we order the dependencies.
|
||||
For I:=0 to FFiles.Count-1 do
|
||||
FFiles[i].OrderDependencies(FUnits);
|
||||
end;
|
||||
|
||||
procedure TPas2FPMakeApp.WriteSources;
|
||||
|
||||
Var
|
||||
@ -238,7 +512,7 @@ begin
|
||||
Terminate;
|
||||
exit;
|
||||
end;
|
||||
TStringList(FUnits).Sorted:=True;
|
||||
ProcessUnits;
|
||||
CreateSources;
|
||||
WriteSources;
|
||||
// stop program loop
|
||||
@ -249,7 +523,7 @@ constructor TPas2FPMakeApp.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
StopOnException:=True;
|
||||
FFiles:=TStringList.Create;
|
||||
FFiles:=TUnitEntries.Create(TUnitEntry);
|
||||
FSrc:=TStringList.Create;
|
||||
FUnits:=TStringList.Create;
|
||||
FPackageName:='Your package name here';
|
||||
@ -272,6 +546,7 @@ begin
|
||||
Writeln(' -p packagename Set package name');
|
||||
Writeln(' -i Use interface units only for checking dependencies');
|
||||
Writeln(' -o outputfile Set output filename (default is standard output)');
|
||||
Writeln(' -v Write diagnostic output to stderr');
|
||||
end;
|
||||
|
||||
var
|
||||
|
||||
Loading…
Reference in New Issue
Block a user