pascalabcnet/bin/TestRunner.pas

// Copyright (c) Ivan Bondarev, Stanislav Mikhalkovich (for details please see \doc\copyright.txt)
// This code is distributed under the GNU LGPL (for details please see \doc\license.txt)
{$reference Compiler.dll}
{$reference CodeCompletion.dll}
{$reference Errors.dll}
{$reference CompilerTools.dll}
{$reference Localization.dll}
{$reference System.Windows.Forms.dll}
{$reference LanguageIntegrator.dll}

uses PascalABCCompiler, System.IO, System.Diagnostics;

type
  LanguageTestsInfo = auto class
 
    languageName: string;
    languageExtensions: array of string;
    commentSymbol: string;
end;

var
  TestSuiteDir: string;
  CurrentLanguageInfo: LanguageTestsInfo;
  nogui: boolean;

var
  PathSeparator: string := Path.DirectorySeparatorChar;

function IsUnix: boolean;
begin
  Result := (System.Environment.OSVersion.Platform = System.PlatformID.Unix) or (System.Environment.OSVersion.Platform = System.PlatformID.MacOSX);  
end;

function GetCurrentLanguageInfo(dir: string): LanguageTestsInfo;
begin
  var configDict := &File.ReadLines(dir + PathSeparator + 'testsettings.config')
                           .Select(line -> line.Split([':', ' '], System.StringSplitOptions.RemoveEmptyEntries))
                           .ToDictionary(arr -> arr[0], arr -> arr[1]);
    
  var languageInformation := Languages.Facade.LanguageProvider.Instance.SelectLanguageByName(configDict['languageName']).LanguageInformation;
    
  Result := new LanguageTestsInfo(languageInformation.Name, languageInformation.FilesExtensions, languageInformation.CommentSymbol);
end;

function GetFilesByExtensions(path: string; extensions: array of string; searchOption: SearchOption := System.IO.SearchOption.TopDirectoryOnly): array of string;
begin
  Result := extensions.SelectMany(ext -> Directory.GetFiles(path, $'*{ext}', searchOption)).ToArray();
end;

function GetCodeExamplesDir: string;
begin
  var dir := Path.GetDirectoryName(GetEXEFileName());
  Result := (new DirectoryInfo(dir)).Parent.FullName + PathSeparator + 'CodeExamples' + PathSeparator + CurrentLanguageInfo.languageName;
end;

procedure CompileErrorTests(withide: boolean);
begin
  
  var dir := TestSuiteDir + PathSeparator + 'errors';
  if not Directory.Exists(dir) then exit;
  
  var commentSymbol := CurrentLanguageInfo.commentSymbol;
  var files := GetFilesByExtensions(dir, CurrentLanguageInfo.languageExtensions);
  for var i := 0 to files.Length - 1 do
  begin
    var comp := new Compiler();
    var content := &File.ReadAllText(files[i]);
    if content.StartsWith(commentSymbol + 'winonly') and IsUnix then
      continue;
    if content.StartsWith(commentSymbol + 'exclude') then
      continue;
    var errorMessage := '';
    if content.StartsWith(commentSymbol + '!') then
    begin
      errorMessage := content.Substring(commentSymbol.Length + 1, content.IndexOf(System.Environment.NewLine) - commentSymbol.Length + 1).Trim;
    end;
    var co: CompilerOptions := new CompilerOptions(files[i], CompilerOptions.OutputType.ConsoleApplicaton);
    co.Debug := true;
    co.OutputDirectory := TestSuiteDir + PathSeparator + 'errors';
    co.UseDllForSystemUnits := false;
    co.RunWithEnvironment := withide;
    comp.ErrorsList.Clear();
    comp.Warnings.Clear();
    
    comp.Compile(co);
    if comp.ErrorsList.Count = 0 then
    begin
      if nogui then
        raise new Exception('Compilation of error sample ' + files[i] + ' was successfull');
      System.Windows.Forms.MessageBox.Show('Compilation of error sample ' + files[i] + ' was successfull' + System.Environment.NewLine);
      Halt();
    end
    else if comp.ErrorsList.Count = 1 then
    begin
      if comp.ErrorsList[0].GetType() = typeof(PascalABCCompiler.Errors.CompilerInternalError) then
      begin
        if nogui then
          raise new Exception('Compilation of ' + files[i] + ' failed' + System.Environment.NewLine + comp.ErrorsList[0].ToString());
        System.Windows.Forms.MessageBox.Show('Compilation of ' + files[i] + ' failed' + System.Environment.NewLine + comp.ErrorsList[0].ToString());
      end;
      if (errorMessage <> '') and (comp.ErrorsList[comp.ErrorsList.Count - 1].Message.Trim <> errorMessage) then
      begin
        if nogui then
          raise new Exception('Wrong error message in file ' + files[i] + ', should ' + errorMessage + ', is ' + comp.ErrorsList[comp.ErrorsList.Count - 1].Message);
        System.Windows.Forms.MessageBox.Show('Wrong error message in file ' + files[i] + ', should ' + errorMessage + ', is ' + comp.ErrorsList[comp.ErrorsList.Count - 1].Message);
      end;
    end;
    if i mod 50 = 0 then
      System.GC.Collect();
  end;
  
end;

procedure CompileAllRunTests(withdll: boolean; only32bit: boolean := false);
begin
  
  var comp := new Compiler();
  
  var commentSymbol := CurrentLanguageInfo.commentSymbol;
  var files := GetFilesByExtensions(TestSuiteDir, CurrentLanguageInfo.languageExtensions);

  for var i := 0 to files.Length - 1 do
  begin
    if IsUnix then
      Println('Compile file ' + files[i]);
    var content := &File.ReadAllText(files[i]);
    if content.StartsWith(commentSymbol + 'winonly') and IsUnix then
      continue;
    if content.StartsWith(commentSymbol + 'nopabcrtl') and withdll then
      continue;
    var co: CompilerOptions := new CompilerOptions(files[i], CompilerOptions.OutputType.ConsoleApplicaton);
    co.Debug := true;
    co.OutputDirectory := TestSuiteDir + PathSeparator + 'exe';
    Directory.CreateDirectory(co.OutputDirectory);
    co.UseDllForSystemUnits := withdll;
    co.RunWithEnvironment := false;
    co.IgnoreRtlErrors := false;
    co.Only32Bit := only32bit;
    comp.ErrorsList.Clear();
    comp.Warnings.Clear();
    
    comp.Compile(co);
    if comp.ErrorsList.Count > 0 then
    begin
      if nogui then
        raise new Exception('Compilation of ' + files[i] + ' failed' + System.Environment.NewLine + comp.ErrorsList[0].ToString());
      System.Windows.Forms.MessageBox.Show('Compilation of ' + files[i] + ' failed' + System.Environment.NewLine + comp.ErrorsList[0].ToString());
      Halt();
    end;
    if content.StartsWith(commentSymbol + '!') then
    begin
      var warning := content.Substring(commentSymbol.Length + 1, content.IndexOf(System.Environment.NewLine) - commentSymbol.Length + 1).Trim;
      if comp.Warnings.Count = 0 then
      begin
        if nogui then
          raise new Exception('Missing warning in ' + files[i]);
        System.Windows.Forms.MessageBox.Show('Missing warning in ' + files[i]);
        Halt();
      end;
      if comp.Warnings[0].Message <> warning then
      begin
        if nogui then
          raise new Exception('Wrong warning for ' + files[i] + ': ' + comp.Warnings[0].Message);
        System.Windows.Forms.MessageBox.Show('Wrong warning for ' + files[i] + ': ' + comp.Warnings[0].Message);
        Halt();
      end;
    end;
    if i mod 50 = 0 then
    begin
      System.GC.Collect();
    end;  
  end;
  //Println;
end;

procedure CompileAllCompilationTests(dir: string; withdll: boolean);
begin
  
  var comp := new Compiler();
  
  var fullDirName := TestSuiteDir + PathSeparator + dir;
  if not Directory.Exists(fullDirName) then exit;
  
  var commentSymbol := CurrentLanguageInfo.commentSymbol;
  var files := GetFilesByExtensions(fullDirName, CurrentLanguageInfo.languageExtensions);
  for var i := 0 to files.Length - 1 do
  begin
    var content := &File.ReadAllText(files[i]);
    if content.StartsWith(commentSymbol + 'winonly') and IsUnix then
      continue;
    var co: CompilerOptions := new CompilerOptions(files[i], CompilerOptions.OutputType.ConsoleApplicaton);
    co.Debug := true;
    co.OutputDirectory := TestSuiteDir + PathSeparator + dir;
    co.UseDllForSystemUnits := withdll;
    co.RunWithEnvironment := false;
    co.IgnoreRtlErrors := false;
    comp.ErrorsList.Clear();
    comp.Warnings.Clear();
    
    comp.Compile(co);
    if comp.ErrorsList.Count > 0 then
    begin
      if nogui then
        raise new Exception('Compilation of ' + files[i] + ' failed' + System.Environment.NewLine + comp.ErrorsList[0].ToString());
      System.Windows.Forms.MessageBox.Show('Compilation of ' + files[i] + ' failed' + System.Environment.NewLine + comp.ErrorsList[0].ToString());
      Halt();
    end;
    if i mod 50 = 0 then
      System.GC.Collect();
  end;
  
end;

procedure CompileAllUnits;
begin
  var comp := new Compiler();
  // Не пропускать ошибки сохранения PCU, в тесте создания PCU
  comp.InternalDebug.SkipPCUErrors := false;
  
  var dir := TestSuiteDir + PathSeparator + 'units' + PathSeparator;
  if not Directory.Exists(dir) then exit;
  
  var commentSymbol := CurrentLanguageInfo.commentSymbol;
  var files := GetFilesByExtensions(TestSuiteDir + PathSeparator + 'units', CurrentLanguageInfo.languageExtensions);
  for var i := 0 to files.Length - 1 do
  begin
    var content := &File.ReadAllText(files[i]);
    if content.StartsWith(commentSymbol + 'winonly') and IsUnix then
      continue;
    var co: CompilerOptions := new CompilerOptions(files[i], CompilerOptions.OutputType.ConsoleApplicaton);
    co.Debug := true;
    co.OutputDirectory := dir;
    co.UseDllForSystemUnits := false;
    comp.ErrorsList.Clear();
    comp.Warnings.Clear();
    
    comp.Compile(co);
    if comp.ErrorsList.Count > 0 then
    begin
      if nogui then
        raise new Exception('Compilation of ' + files[i] + ' failed' + System.Environment.NewLine + comp.ErrorsList[0].ToString());
      System.Windows.Forms.MessageBox.Show('Compilation of ' + files[i] + ' failed' + System.Environment.NewLine + comp.ErrorsList[0].ToString());
      Halt();
    end;
  end;
  System.GC.Collect;
end;

procedure CompileAllUsesUnits;
begin
  var comp := new Compiler();
  
  var dir := TestSuiteDir + PathSeparator + 'usesunits';
  
  if not Directory.Exists(dir) then exit;
  
  var commentSymbol := CurrentLanguageInfo.commentSymbol;
  var files := GetFilesByExtensions(dir, CurrentLanguageInfo.languageExtensions);
  for var i := 0 to files.Length - 1 do
  begin
    var content := &File.ReadAllText(files[i]);
    if content.StartsWith(commentSymbol + 'winonly') and IsUnix then
      continue;
    var co: CompilerOptions := new CompilerOptions(files[i], CompilerOptions.OutputType.ConsoleApplicaton);
    co.Debug := true;
    co.OutputDirectory := TestSuiteDir + PathSeparator + 'exe';
    co.UseDllForSystemUnits := false;
    comp.ErrorsList.Clear();
    comp.Warnings.Clear();
    comp.Compile(co);
    if comp.ErrorsList.Count > 0 then
    begin
      if nogui then
        raise new Exception('Compilation of ' + files[i] + ' failed' + System.Environment.NewLine + comp.ErrorsList[0].ToString());
      System.Windows.Forms.MessageBox.Show('Compilation of ' + files[i] + ' failed' + System.Environment.NewLine + comp.ErrorsList[0].ToString());
      Halt();
    end;
  end;
  System.GC.Collect;
end;

procedure CopyPCUFiles;
begin  
  var dir := TestSuiteDir + PathSeparator + 'units';
  if not Directory.Exists(dir) then exit;
  
  var files := Directory.GetFiles(dir, '*.pcu');
  
  foreach fname: string in files do
  begin
    &File.Move(fname, TestSuiteDir + PathSeparator + 'usesunits' + PathSeparator + Path.GetFileName(fname));
  end;
end;

procedure RunAllTests(redirectIO: boolean);
begin
  var dlls := Directory.GetFiles(TestSuiteDir, '*.dll');
  foreach var dll in dlls do
  begin
    System.IO.File.Copy(dll, TestSuiteDir + PathSeparator + 'exe' + PathSeparator + Path.GetFileName(dll), true);
  end;
  
  var dir := TestSuiteDir + PathSeparator + 'exe';
  if not Directory.Exists(dir) then exit;
  
  var files := Directory.GetFiles(dir, '*.exe');
  for var i := 0 to files.Length - 1 do
  begin
    //Println(files[i]);
    var psi := new System.Diagnostics.ProcessStartInfo(files[i]);
    psi.CreateNoWindow := true;
    psi.UseShellExecute := false;
    
    psi.WorkingDirectory := TestSuiteDir + PathSeparator + 'exe';
		  {psi.RedirectStandardInput := true;
		  psi.RedirectStandardOutput := true;
		  psi.RedirectStandardError := true;}
    var p: Process := new Process();
    p.StartInfo := psi;
    p.Start();
    if redirectIO then
      p.StandardInput.WriteLine('GO');
		  //p.StandardInput.AutoFlush := true;
		  //var p := System.Diagnostics.Process.Start(psi);
    if nogui then
    begin
      var success := p.WaitForExit(60000);
      if not success then
      begin
        raise new Exception('Running of ' + files[i] + ' failed.');
      end;
    end
    else
      p.WaitForExit();
    //while not p.HasExited do
    //  Sleep(5);
    if p.ExitCode <> 0 then
    begin
      if nogui then
        raise new Exception('Running of ' + files[i] + ' failed. Exit code is not 0');
      System.Windows.Forms.MessageBox.Show('Running of ' + files[i] + ' failed. Exit code is not 0');
      Halt;
    end;
  end;
end;

procedure RunExpressionsExtractTests;
begin
  // Пока для других языков не поддерживается
  if CurrentLanguageInfo.languageName <> 'PascalABC.NET' then exit;
  CodeCompletion.CodeCompletionTester.Test();
end;

function GetLineByPos(lines: array of string; pos: integer): integer;
begin
  var cum_pos := 0;
  for var i := 0 to lines.Length - 1 do
    for var j := 0 to lines[j].Length - 1 do
    begin
      if cum_pos = pos then
      begin
        Result := i + 1;
        exit;
      end;
      Inc(cum_pos);  
    end;
end;

function GetColByPos(lines: array of string; pos: integer): integer;
begin
  var cum_pos := 0;
  for var i := 0 to lines.Length - 1 do
    for var j := 0 to lines[j].Length - 1 do
    begin
      if cum_pos = pos then
      begin
        Result := j + 1;
        exit;
      end;
      Inc(cum_pos);  
    end;
end;

procedure RunIntellisenseTests;
begin
  var dir := TestSuiteDir + PathSeparator + 'intellisense_tests';
  if not Directory.Exists(dir) then exit;
  
  PascalABCCompiler.StringResourcesLanguage.CurrentTwoLetterISO := 'ru';
  CodeCompletion.CodeCompletionTester.TestIntellisense(dir);
end;

procedure RunFormatterTests;
begin
  var dir := TestSuiteDir + PathSeparator + 'formatter_tests';
  if not Directory.Exists(dir) then exit;
  
  CodeCompletion.FormatterTester.Test();
  var errors := &File.ReadAllText(dir + PathSeparator + 'output' + PathSeparator + 'log.txt');
  if not string.IsNullOrEmpty(errors) then
  begin
    var dirInfo := new DirectoryInfo(TestSuiteDir);
    
    if nogui then
      raise new Exception('Formatter tests failed.' + NewLine + errors);
    System.Windows.Forms.MessageBox.Show(errors + System.Environment.NewLine + $'more info at {dirInfo.Parent.Name}/{dirInfo.Name}/formatter_tests/output/log.txt');
    Halt;
  end;
end;

procedure ClearDirByPattern(dir, pattern: string);
begin
  if not Directory.Exists(dir) then exit;
  var files := Directory.GetFiles(dir, pattern);
  for var i := 0 to files.Length - 1 do
  begin
    try
      if Path.GetFileName(files[i]) <> '.gitignore' then
        &File.Delete(files[i]);
    except
    end;
  end;
end;

procedure ClearExeDir;
begin
  ClearDirByPattern(TestSuiteDir + PathSeparator + 'exe', '*.*');
  ClearDirByPattern(TestSuiteDir + PathSeparator + 'CompilationSamples', '*.exe');
  ClearDirByPattern(TestSuiteDir + PathSeparator + 'CompilationSamples', '*.mdb');
  ClearDirByPattern(TestSuiteDir + PathSeparator + 'CompilationSamples', '*.pdb');
  ClearDirByPattern(TestSuiteDir + PathSeparator + 'CompilationSamples', '*.pcu');
  ClearDirByPattern(TestSuiteDir + PathSeparator + 'pabcrtl_tests', '*.exe');
  ClearDirByPattern(TestSuiteDir + PathSeparator + 'pabcrtl_tests', '*.pdb');
  ClearDirByPattern(TestSuiteDir + PathSeparator + 'pabcrtl_tests', '*.mdb');
  ClearDirByPattern(TestSuiteDir + PathSeparator + 'pabcrtl_tests', '*.pcu');
end;

procedure DeletePCUFiles;
begin
  ClearDirByPattern(TestSuiteDir + PathSeparator + 'usesunits', '*.pcu');
end;

//procedure DeletePABCSystemPCU;
//begin
//  var dir := Path.Combine(Path.GetDirectoryName(GetEXEFileName()), 'Lib');
//  var pcu := Path.Combine(dir, 'PABCSystem.pcu');
//end;

/// Копирует всю папку CodeExamples в TestSuite (если такая уже есть, то предварительно удаляет её)
procedure CopyCodeExamples;
begin
  var dir := GetCodeExamplesDir();
  if not Directory.Exists(dir) then exit;
  
  var files := GetFilesByExtensions(dir, CurrentLanguageInfo.languageExtensions, SearchOption.AllDirectories);
  var destinationDir := TestSuiteDir + PathSeparator + 'CodeExamples' + PathSeparator;
  
  if Directory.Exists(destinationDir) then 
    Directory.Delete(destinationDir, True);
  
  Directory.CreateDirectory(destinationDir);
 
  foreach f: string in files do
  begin
    &File.Copy(f, destinationDir + Path.GetFileName(f), true);
  end;
end;

function MsToMinutes(ms: integer) : string;
begin
  var span := System.TimeSpan.FromMilliseconds(ms);
  Result := span.Minutes > 0 ? $'{span.Minutes}m {span.Seconds}s' : $'{span.Seconds}s';
end;

begin
  //DeletePABCSystemPCU;
  try
    Languages.Integration.LanguageIntegrator.LoadAllLanguages();
    
    TestSuiteDir := System.Environment.CurrentDirectory;
    
    System.Environment.CurrentDirectory := Path.GetDirectoryName(GetEXEFileName());
    
    CurrentLanguageInfo := GetCurrentLanguageInfo(TestSuiteDir);
    
    if (ParamCount = 0) or (ParamStr(1) = '1') then
      Println($'----- {CurrentLanguageInfo.languageName} тесты -----');
    
    if (ParamCount = 2) and (ParamStr(2) = '1') then
      nogui := true;
    if (ParamCount = 0) or (ParamStr(1) = '1') then
    begin
      Println('Compiling tests...');
      DeletePCUFiles;
      ClearExeDir;
      CompileAllRunTests(false);
      Println('Success. Time elapsed: ' + MsToMinutes(MillisecondsDelta()));
    end;
    
    if (ParamCount = 0) or (ParamStr(1) = '2') then
    begin
      Println('Compiling compilation samples...');
      CopyCodeExamples;
      CompileAllCompilationTests('CodeExamples', false);
      CompileAllCompilationTests('CompilationSamples', false);
      Println('Success. Time elapsed: ' + MsToMinutes(MillisecondsDelta()));
    end;
    if (ParamCount = 0) or (ParamStr(1) = '3') then
    begin
      Println('Compiling tests with multiple units and error throwing tests...');
      CompileAllUnits;
      CopyPCUFiles;
      CompileAllUsesUnits;
      CompileErrorTests(false);
      Println('Success. Time elapsed: ' + MsToMinutes(MillisecondsDelta()));
    end;
    if (ParamCount = 0) or (ParamStr(1) = '4') then
    begin
      Println('Running tests...');
      RunAllTests(false);
      Println('Success. Time elapsed: ' + MsToMinutes(MillisecondsDelta()));
      ClearExeDir;
      DeletePCUFiles;
    end;
    if (ParamCount = 0) or (ParamStr(1) = '5') then
    begin
      Println('Compiling tests in 32bit mode...');
      CompileAllRunTests(false, true);
      Println('Success. Time elapsed: ' + MsToMinutes(MillisecondsDelta()));
      Println('Running tests in 32bit mode...');
      RunAllTests(false);
      Println('Success. Time elapsed: ' + MsToMinutes(MillisecondsDelta()));
      ClearExeDir;
      Println('Compiling tests with PABCRtl.dll...');
      CompileAllRunTests(true);
      Println('Success. Time elapsed: ' + MsToMinutes(MillisecondsDelta()));
      Println('Compiling compilation samples with PABCRtl.dll...');
      CompileAllCompilationTests('pabcrtl_tests', true);
      Println('Success. Time elapsed: ' + MsToMinutes(MillisecondsDelta()));
    end;
    if (ParamCount = 0) or (ParamStr(1) = '6') then
    begin
      Println('Running tests with PABCRtl.dll...');
      RunAllTests(false);
      Println('Success. Time elapsed: ' + MsToMinutes(MillisecondsDelta()));
      Println('Running intellisense expression tests...');
      RunExpressionsExtractTests;
      Println('Success. Time elapsed: ' + MsToMinutes(MillisecondsDelta()));
      Println('Running basic intellisense tests...');
      RunIntellisenseTests;
      Println('Success. Time elapsed: ' + MsToMinutes(MillisecondsDelta()));
      Println('Running formatter tests...');
      RunFormatterTests;
      Println('Success. Time elapsed: ' + MsToMinutes(MillisecondsDelta()));
    end;
  except
    on e: Exception do
    begin
      if nogui then
        raise new Exception(e.ToString());
      assert(false, e.ToString());
    end;
  
  end;
end.