del UniqueInstance

.github/workflows/make.pas

@@ -1,4 +1,5 @@
 program Make;
+{$UNITPATH /usr/lib/lazarus/3.0/components/lazutils}
 {$mode objfpc}{$H+}
 
 uses
@@ -14,139 +15,191 @@
 
 const
   Src: string = 'src';
-  Use: string = 'use';
+  Use: string = 'src';
   Tst: string = 'testconsole.lpi';
-  Pkg: array of string = ('UniqueInstance');
+  Pkg: array of string = ();
+
+type
+  Output = record
+    Code: integer;
+    Output: ansistring;
+  end;
 
 var
-  Output, Line: ansistring;
-  List: TStringList;
   Each, Item, PackagePath, TempFile, Url: string;
+  Line: ansistring;
+  Answer: Output;
+  List: TStringList;
   Zip: TStream;
 
-begin
-  InitSSLInterface;
-  if FileExists('.gitmodules') then
-    if RunCommand('git', ['submodule', 'update', '--init', '--recursive',
-      '--force', '--remote'], Output) then
-      Writeln(#27'[33m', Output, #27'[0m')
-    else
-    begin
-      ExitCode += 1;
-      Writeln(#27'[31m', Output, #27'[0m');
-    end;
-  List := FindAllFiles(Use, '*.lpk', True);
-  try
-    for Each in List do
-      if RunCommand('lazbuild', ['--add-package-link', Each], Output) then
-        Writeln(#27'[33m', 'added ', Each, #27'[0m')
+  procedure CheckModules;
+  begin
+    if FileExists('.gitmodules') then
+      if RunCommand('git', ['submodule', 'update', '--init', '--recursive',
+        '--force', '--remote'], Answer.Output) then
+        Writeln(stderr, #27'[33m', Answer.Output, #27'[0m')
       else
       begin
         ExitCode += 1;
-        Writeln(#27'[31m', 'added ', Each, #27'[0m');
+        Writeln(stderr, #27'[31m', Answer.Output, #27'[0m');
       end;
-  finally
-    List.Free;
   end;
-  for Each in Pkg do
+
+  procedure AddPackage(Path: string);
   begin
-    PackagePath := GetEnvironmentVariable('HOME') +
-      '/.lazarus/onlinepackagemanager/packages/' + Each;
-    TempFile := GetTempFileName;
-    Url := 'https://packages.lazarus-ide.org/' + Each + '.zip';
-    if not DirectoryExists(PackagePath) then
-    begin
-      Zip := TFileStream.Create(TempFile, fmCreate or fmOpenWrite);
-      with TFPHttpClient.Create(nil) do
-      begin
-        try
-          AddHeader('User-Agent', 'Mozilla/5.0 (compatible; fpweb)');
-          AllowRedirect := True;
-          Get(Url, Zip);
-          WriteLn('Download from ', Url, ' to ', TempFile);
-        finally
-          Free;
+    List := FindAllFiles(Use, '*.lpk', True);
+    try
+      for Each in List do
+        if RunCommand('lazbuild', ['--add-package-link', Each], Answer.Output) then
+          Writeln(stderr, #27'[33m', 'added ', Each, #27'[0m')
+        else
+        begin
+          ExitCode += 1;
+          Writeln(stderr, #27'[31m', 'added ', Each, #27'[0m');
         end;
-      end;
-      Zip.Free;
-      CreateDir(PackagePath);
-      with TUnZipper.Create do
+    finally
+      List.Free;
+    end;
+  end;
+
+  procedure AddOPM;
+  begin
+    InitSSLInterface;
+    for Each in Pkg do
+    begin
+      PackagePath :=
+        {$IFDEF MSWINDOWS}
+        GetEnvironmentVariable('APPDATA') + '\.lazarus\onlinepackagemanager\packages\'
+        {$ELSE}
+      GetEnvironmentVariable('HOME') + '/.lazarus/onlinepackagemanager/packages/'
+        {$ENDIF}
+        + Each;
+      TempFile := GetTempFileName;
+      Url := 'https://packages.lazarus-ide.org/' + Each + '.zip';
+      if not DirectoryExists(PackagePath) then
       begin
-        try
-          FileName := TempFile;
-          OutputPath := PackagePath;
-          Examine;
-          UnZipAllFiles;
-          WriteLn('Unzip from ', TempFile, ' to ', PackagePath);
-        finally
-          Free;
+        Zip := TFileStream.Create(TempFile, fmCreate or fmOpenWrite);
+        with TFPHttpClient.Create(nil) do
+        begin
+          try
+            AddHeader('User-Agent', 'Mozilla/5.0 (compatible; fpweb)');
+            AllowRedirect := True;
+            Get(Url, Zip);
+            WriteLn(stderr, 'Download from ', Url, ' to ', TempFile);
+          finally
+            Free;
+          end;
         end;
-      end;
-      DeleteFile(TempFile);
-      List := FindAllFiles(PackagePath, '*.lpk', True);
-      try
-        for Item in List do
-          if RunCommand('lazbuild', ['--add-package-link', Item], Output) then
-            Writeln(#27'[33m', 'added ', Item, #27'[0m')
-          else
-          begin
-            ExitCode += 1;
-            Writeln(#27'[31m', 'added ', Item, #27'[0m');
+        Zip.Free;
+        CreateDir(PackagePath);
+        with TUnZipper.Create do
+        begin
+          try
+            FileName := TempFile;
+            OutputPath := PackagePath;
+            Examine;
+            UnZipAllFiles;
+            WriteLn(stderr, 'Unzip from ', TempFile, ' to ', PackagePath);
+          finally
+            Free;
           end;
-      finally
-        List.Free;
+        end;
+        DeleteFile(TempFile);
+        AddPackage(PackagePath);
       end;
     end;
   end;
-  List := FindAllFiles('.', Tst, True);
-  try
-    for Each in List do
-    begin
-      Writeln(#27'[33m', 'build ', Each, #27'[0m');
+
+  procedure BuildProject(Path: string);
+  begin
+    Write(stderr, #27'[33m', 'build from ', Each, #27'[0m');
+    try
       if RunCommand('lazbuild', ['--build-all', '--recursive',
-        '--no-write-project', Each], Output) then
-        for Line in SplitString(Output, LineEnding) do
+        '--no-write-project', Each], Answer.Output) then
+        Answer.Code := 0
+      else
+      begin
+        Answer.Code := 1;
+        ExitCode += Answer.Code;
+      end;
+    except
+      on E: Exception do
+        WriteLn(stderr, 'Error: ' + E.ClassName + #13#10 + E.Message);
+    end;
+  end;
+
+  procedure RunTest;
+  begin
+    List := FindAllFiles('.', Tst, True);
+    try
+      for Each in List do
+      begin
+        BuildProject(Each);
+        if Answer.Code <> 0 then
         begin
-          if Pos('Linking', Line) <> 0 then
-          begin
-            if not RunCommand('command', [SplitString(Line, ' ')[2],
-              '--all', '--format=plain', '--progress'], Output) then
-              ExitCode += 1;
-            WriteLn(Output);
-          end;
+          for Line in SplitString(Answer.Output, LineEnding) do
+            if Pos('Fatal:', Line) <> 0 or Pos('Error:', Line) then
+            begin
+              WriteLn(stderr);
+              Writeln(stderr, #27'[31m', Line, #27'[0m');
+            end;
         end
-      else
-        for Line in SplitString(Output, LineEnding) do
-          if Pos('Fatal', Line) <> 0 or Pos('Error', Line) then
-            Writeln(#27'[31m', Line, #27'[0m');
+        else
+          for Line in SplitString(Answer.Output, LineEnding) do
+            if Pos('Linking', Line) <> 0 then
+            try
+              begin
+                Writeln(stderr, #27'[32m', ' to ', SplitString(Line, ' ')[2], #27'[0m');
+                if not RunCommand(ReplaceStr(SplitString(Line, ' ')[2],
+                  SplitString(Tst, '.')[0], './' + SplitString(Tst, '.')[0]),
+                  ['--all', '--format=plain', '--progress'], Answer.Output) then
+                  ExitCode += 1;
+                WriteLn(stderr, Answer.Output);
+                break;
+              end;
+            except
+              on E: Exception do
+                WriteLn(stderr, 'Error: ' + E.ClassName + #13#10 + E.Message);
+            end;
+      end;
+    finally
+      List.Free;
     end;
-  finally
-    List.Free;
   end;
+
+begin
+  CheckModules;
+  AddPackage(Use);
+  AddOPM;
+  {$IFDEF LINUX}
+  RunTest;
+  {$ENDIF}
   List := FindAllFiles(Src, '*.lpi', True);
   try
     for Each in List do
-    begin
-      Write(#27'[33m', 'build from ', Each, #27'[0m');
-      if RunCommand('lazbuild', ['--build-all', '--recursive',
-        '--no-write-project', Each], Output) then
-        for Line in SplitString(Output, LineEnding) do
-        begin
-          if Pos('Linking', Line) <> 0 then
-            Writeln(#27'[32m', ' to ', SplitString(Line, ' ')[2], #27'[0m');
-        end
-      else
+      if Pos(Tst, Each) = 0 then
       begin
-        ExitCode += 1;
-        for Line in SplitString(Output, LineEnding) do
-          if Pos('Fatal:', Line) <> 0 or Pos('Error:', Line) then
+        BuildProject(Each);
+        if Answer.Code <> 0 then
+        begin
+          for Line in SplitString(Answer.Output, LineEnding) do
+            if Pos('Fatal:', Line) <> 0 or Pos('Error:', Line) then
             begin
-              WriteLn();
-              Writeln(#27'[31m', Line, #27'[0m');
+              WriteLn(stderr);
+              Writeln(stderr, #27'[31m', Line, #27'[0m');
             end;
+        end
+        else
+          for Line in SplitString(Answer.Output, LineEnding) do
+            if Pos('Linking', Line) <> 0 then
+              Writeln(stderr, #27'[32m', ' to ', SplitString(Line, ' ')[2], #27'[0m');
       end;
-    end;
   finally
     List.Free;
   end;
+  WriteLn(stderr);
+  if ExitCode <> 0 then
+    WriteLn(stderr, #27'[31m', 'Errors: ', ExitCode, #27'[0m')
+  else
+    WriteLn(stderr, #27'[32m', 'Errors: ', ExitCode, #27'[0m');
 end.