make.pas 4.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183
  1. program Make;
  2. {$mode objfpc}{$H+}
  3. {$unitpath /usr/lib64/lazarus/components/lazutils}
  4. uses
  5. Classes,
  6. SysUtils,
  7. StrUtils,
  8. FileUtil,
  9. Zipper,
  10. fphttpclient,
  11. RegExpr,
  12. openssl,
  13. opensslsockets,
  14. Process;
  15. const
  16. Target: string = 'CryptoLib.Tests';
  17. Dependencies: array of string = ('HashLib', 'SimpleBaseLib');
  18. type
  19. TLog = (audit, info, error);
  20. Output = record
  21. Success: boolean;
  22. Output: string;
  23. end;
  24. procedure OutLog(const Knd: TLog; const Msg: string);
  25. begin
  26. case Knd of
  27. error: Writeln(stderr, #27'[31m', Msg, #27'[0m');
  28. info: Writeln(stderr, #27'[32m', Msg, #27'[0m');
  29. audit: Writeln(stderr, #27'[33m', Msg, #27'[0m');
  30. end;
  31. end;
  32. function CheckModules: string;
  33. begin
  34. if FileExists('.gitmodules') then
  35. if RunCommand('git', ['submodule', 'update', '--init', '--recursive',
  36. '--force', '--remote'], Result) then
  37. OutLog(info, Result)
  38. else
  39. OutLog(error, Result);
  40. end;
  41. function AddPackage(const Path: string): string;
  42. begin
  43. if RunCommand('lazbuild', ['--add-package-link', Path], Result) then
  44. OutLog(audit, 'Add package:'#9 + Path);
  45. end;
  46. function SelectString(const Input, Reg: string): string;
  47. var
  48. Line: string;
  49. begin
  50. Result := ' ';
  51. for Line in Input.Split(LineEnding) do
  52. with TRegExpr.Create do
  53. begin
  54. Expression := Reg;
  55. if Exec(Line) then
  56. Result += Line + LineEnding;
  57. Free;
  58. end;
  59. end;
  60. function RunTest(const Path: String): string;
  61. begin
  62. OutLog(audit, #9'run:'#9 + Path);
  63. if RunCommand(Path, ['--all', '--format=plain'], Result) then
  64. OutLog(info, #9'success!')
  65. else
  66. ExitCode += 1;
  67. OutLog(audit, Result);
  68. end;
  69. function BuildProject(const Path: string): Output;
  70. begin
  71. OutLog(audit, 'Build from:'#9 + Path);
  72. Result.Success := RunCommand('lazbuild',
  73. ['--build-all', '--recursive', '--no-write-project', Path], Result.Output);
  74. Result.Output := SelectString(Result.Output, '(Fatal:|Error:|Linking)');
  75. if Result.Success then
  76. begin
  77. Result.Output := Result.Output.Split(' ')[3].Replace(LineEnding, '');
  78. OutLog(info, #9'to:'#9 + Result.Output);
  79. if ContainsStr(ReadFileToString(Path.Replace('.lpi', '.lpr')), 'consoletestrunner') then
  80. RunTest(Result.Output.Replace(#10, ''));
  81. end
  82. else
  83. begin
  84. ExitCode += 1;
  85. OutLog(error, Result.Output);
  86. end;
  87. end;
  88. function DownloadFile(const Uri: string): string;
  89. var
  90. OutFile: TStream;
  91. begin
  92. InitSSLInterface;
  93. Result := GetTempFileName;
  94. OutFile := TFileStream.Create(Result, fmCreate or fmOpenWrite);
  95. with TFPHttpClient.Create(nil) do
  96. begin
  97. try
  98. AddHeader('User-Agent', 'Mozilla/5.0 (compatible; fpweb)');
  99. AllowRedirect := True;
  100. Get(Uri, OutFile);
  101. OutLog(audit, 'Download from ' + Uri + ' to ' + Result);
  102. finally
  103. Free;
  104. OutFile.Free;
  105. end;
  106. end;
  107. end;
  108. procedure UnZip(const ZipFile, ZipPath: string);
  109. begin
  110. with TUnZipper.Create do
  111. begin
  112. try
  113. FileName := ZipFile;
  114. OutputPath := ZipPath;
  115. Examine;
  116. UnZipAllFiles;
  117. OutLog(audit, 'Unzip from'#9 + ZipFile + #9'to'#9 + ZipPath);
  118. DeleteFile(ZipFile);
  119. finally
  120. Free;
  121. end;
  122. end;
  123. end;
  124. function InstallOPM(const Path: string): string;
  125. begin
  126. Result :=
  127. {$IFDEF MSWINDOWS}
  128. GetEnvironmentVariable('APPDATA') + '\.lazarus\onlinepackagemanager\packages\'
  129. {$ELSE}
  130. GetEnvironmentVariable('HOME') + '/.lazarus/onlinepackagemanager/packages/'
  131. {$ENDIF}
  132. + Path;
  133. if not DirectoryExists(Result) then
  134. begin
  135. CreateDir(Result);
  136. UnZip(DownloadFile('https://packages.lazarus-ide.org/' + Path + '.zip'), Result);
  137. end;
  138. end;
  139. function BuildAll: string;
  140. var
  141. List: TStringList;
  142. begin
  143. CheckModules;
  144. List := FindAllFiles(GetCurrentDir, '*.lpk', True);
  145. try
  146. for Result in Dependencies do
  147. List.AddStrings(FindAllFiles(InstallOPM(Result), '*.lpk', True));
  148. for Result in List do
  149. AddPackage(Result);
  150. List := FindAllFiles(Target, '*.lpi', True);
  151. for Result in List do
  152. BuildProject(Result);
  153. finally
  154. List.Free;
  155. end;
  156. case ExitCode of
  157. 0: OutLog(info, 'Errors:'#9 + IntToStr(ExitCode));
  158. else
  159. OutLog(error, 'Errors:'#9 + IntToStr(ExitCode));
  160. end;
  161. end;
  162. begin
  163. try
  164. BuildAll
  165. except
  166. on E: Exception do
  167. Writeln(E.ClassName, #9, E.Message);
  168. end;
  169. end.