* Interdependency reduction, verbosity introduced

git-svn-id: trunk@22214 -

utils/pas2fpm/pas2fpm.pp

@@ -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