// Copyright (c) Ivan Bondarev, Stanislav Mihalkovich (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; 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 comp := new Compiler(); var files := Directory.GetFiles(TestSuiteDir + PathSeparator + 'errors', '*.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 + 'errors'; co.UseDllForSystemUnits := false; co.RunWithEnvironment := withide; comp.ErrorsList.Clear(); comp.Warnings.Clear(); comp.Compile(co); if comp.ErrorsList.Count = 0 then begin 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 System.Windows.Forms.MessageBox.Show('Compilation of ' + files[i] + ' failed' + System.Environment.NewLine + comp.ErrorsList[0].ToString()); end; if i mod 20 = 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 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 := 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 System.Windows.Forms.MessageBox.Show('Compilation of ' + files[i] + ' failed' + System.Environment.NewLine + comp.ErrorsList[0].ToString()); Halt(); end; if i mod 20 = 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 System.Windows.Forms.MessageBox.Show('Compilation of ' + files[i] + ' failed' + System.Environment.NewLine + comp.ErrorsList[0].ToString()); Halt(); end; if i mod 20 = 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 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 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 files := Directory.GetFiles(TestSuiteDir + PathSeparator + 'exe', '*.exe'); for var i := 0 to files.Length - 1 do begin 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); while not p.HasExited do Sleep(10); if p.ExitCode <> 0 then begin 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 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 = 0) or (ParamStr(1) = '1') then begin DeletePCUFiles; ClearExeDir; CompileAllRunTests(false); end; if (ParamCount = 0) or (ParamStr(1) = '2') then begin CopyLibFiles; CompileAllCompilationTests('CompilationSamples', false); end; if (ParamCount = 0) or (ParamStr(1) = '3') then begin CompileAllUnits; CopyPCUFiles; CompileAllUsesUnits; CompileErrorTests(false); writeln('Tests compiled successfully'); end; if (ParamCount = 0) or (ParamStr(1) = '4') then begin RunAllTests(false); writeln('Tests run successfully'); ClearExeDir; DeletePCUFiles; end; if (ParamCount = 0) or (ParamStr(1) = '5') then begin CompileAllRunTests(true); writeln('Tests with pabcrtl compiled successfully'); CompileAllCompilationTests('pabcrtl_tests', true); RunAllTests(false); writeln('Tests with pabcrtl run successfully'); ClearExeDir; CompileAllRunTests(false, true); writeln('Tests in 32bit mode compiled successfully'); RunAllTests(false); writeln('Tests in 32bit 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 assert(false, e.ToString()); end; end.