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}

uses PascalABCCompiler, System.IO, System.Diagnostics;

var
  TestSuiteDir: string;
  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 GetTestSuiteDir: string;
begin
  var dir := Path.GetDirectoryName(GetEXEFileName());
  var ind := dir.LastIndexOf('bin');
  Result := dir.Substring(0, ind) + 'TestSuite';
end;

function GetLibDir: string;
begin
  var dir := Path.GetDirectoryName(GetEXEFileName());
  Result := dir + PathSeparator + 'Lib';
end;

procedure CompileErrorTests(withide: boolean);
begin
  
  
  
  var files := Directory.GetFiles(TestSuiteDir + PathSeparator + 'errors', '*.pas');
  for var i := 0 to files.Length - 1 do
  begin
    var comp := new Compiler();
    var content := &File.ReadAllText(files[i]);
    if content.StartsWith('//winonly') and IsUnix then
      continue;
    if content.StartsWith('//exclude') then
      continue;
    var errorMessage := '';
    if content.StartsWith('//!') then
    begin
      errorMessage := content.Substring(3, content.IndexOf(System.Environment.NewLine)-3).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 files := Directory.GetFiles(TestSuiteDir, '*.pas');
  for var i := 0 to files.Length - 1 do
  begin
    if IsUnix then
      writeln('Compile file '+files[i]);
    var content := &File.ReadAllText(files[i]);
    if content.StartsWith('//winonly') and IsUnix then
      continue;
    if content.StartsWith('//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 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 files := Directory.GetFiles(TestSuiteDir + PathSeparator + dir, '*.pas');
  for var i := 0 to files.Length - 1 do
  begin
    var content := &File.ReadAllText(files[i]);
    if content.StartsWith('//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();
  var files := Directory.GetFiles(TestSuiteDir + PathSeparator + 'units', '*.pas');
  var dir := TestSuiteDir + PathSeparator + 'units' + PathSeparator;
  for var i := 0 to files.Length - 1 do
  begin
    var content := &File.ReadAllText(files[i]);
    if content.StartsWith('//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
  System.Environment.CurrentDirectory := Path.GetDirectoryName(GetEXEFileName());
  var comp := new Compiler();
  
  var files := Directory.GetFiles(TestSuiteDir + PathSeparator + 'usesunits', '*.pas');
  for var i := 0 to files.Length - 1 do
  begin
    var content := &File.ReadAllText(files[i]);
    if content.StartsWith('//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
  System.Environment.CurrentDirectory := Path.GetDirectoryName(GetEXEFileName());
  var files := Directory.GetFiles(TestSuiteDir + PathSeparator + 'units', '*.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 files := Directory.GetFiles(TestSuiteDir + PathSeparator + 'exe', '*.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
  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
  PascalABCCompiler.StringResourcesLanguage.CurrentTwoLetterISO := 'ru';
  CodeCompletion.CodeCompletionTester.TestIntellisense(TestSuiteDir + PathSeparator + 'intellisense_tests');
end;

procedure RunFormatterTests;
begin
  CodeCompletion.FormatterTester.Test();
  var errors := &File.ReadAllText(TestSuiteDir + PathSeparator + 'formatter_tests' + PathSeparator + 'output' + PathSeparator + 'log.txt');
  if not string.IsNullOrEmpty(errors) then
  begin
    System.Windows.Forms.MessageBox.Show(errors + System.Environment.NewLine + 'more info at TestSuite/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;

procedure CopyLibFiles;
begin
  var files := Directory.GetFiles(GetLibDir(), '*.pas');
  foreach f: string in files do
  begin
    &File.Copy(f, TestSuiteDir + PathSeparator + 'CompilationSamples' + PathSeparator + Path.GetFileName(f), true);
  end;
end;

begin
  //DeletePABCSystemPCU;
  try
    TestSuiteDir := GetTestSuiteDir;
    System.Environment.CurrentDirectory := Path.GetDirectoryName(GetEXEFileName());
    if (ParamCount = 2) and (ParamStr(2) = '1') then
      nogui := true;
    if (ParamCount = 0) or (ParamStr(1) = '1') then
    begin
      DeletePCUFiles;
      ClearExeDir;
      CompileAllRunTests(false);
      writeln('Tests to run: '+Milliseconds()+'ms');
    end;
    
    if (ParamCount = 0) or (ParamStr(1) = '2') then
    begin
      CopyLibFiles;
      CompileAllCompilationTests('CompilationSamples', false);
      writeln('CompilationSamples: '+Milliseconds()+'ms');
    end;
    if (ParamCount = 0) or (ParamStr(1) = '3') then
    begin
      CompileAllUnits;
      CopyPCUFiles;
      CompileAllUsesUnits;
      CompileErrorTests(false);
      writeln('Other tests '+Milliseconds()+'ms'+'. Tests compiled successfully ');
    end;
    if (ParamCount = 0) or (ParamStr(1) = '4') then
    begin
      RunAllTests(false);
      writeln('Tests run successfully: '+Milliseconds()+'ms');
      ClearExeDir;
      DeletePCUFiles;
    end;
    if (ParamCount = 0) or (ParamStr(1) = '5') then
    begin
      
        CompileAllRunTests(false, true);
        writeln('Tests in 32bit mode compiled successfully');
        RunAllTests(false);
        writeln('Tests in 32bit run successfully');
        ClearExeDir;
        CompileAllRunTests(true);
        writeln('Tests with pabcrtl compiled successfully');
        CompileAllCompilationTests('pabcrtl_tests', true);
    end;
    if (ParamCount = 0) or (ParamStr(1) = '6') then
    begin
      RunAllTests(false);
      writeln('Tests with pabcrtl run successfully');
      System.Environment.CurrentDirectory := Path.GetDirectoryName(GetEXEFileName());
      RunExpressionsExtractTests;
      writeln('Intellisense expression tests run successfully');
      RunIntellisenseTests;
      writeln('Intellisense tests run successfully');
      RunFormatterTests;
      writeln('Formatter tests run successfully');
    end;
  except
    on e: Exception do
    begin
      if nogui then
        raise new Exception(e.ToString());
      assert(false, e.ToString());
    end;
     
  end;
end.