tests: log compiler output is compilation of a test project fails.

git-svn-id: trunk@16166 -

test/bugtestcase.pas

@@ -46,68 +46,10 @@ type
   
 implementation
 
-const
-  // Maximal number of bytes read from stream
-  READ_BYTES = 2048;
-  // Maximal run time for a test program
-  TIME_OUT = 30;
-
 var
-  BufferedOutput: TMemoryStream; // a global variable is not nice, but it works.
+ // a global variable to pass information between tests is not nice, but it works
+  RunOutput: TStringList;
   
-procedure ReadOutput(AProcess:TProcess);
-var
-  BytesRead: Integer;
-  n: Integer;
-  EndTime: TDateTime;
-begin
-  BytesRead := 0;
-  BufferedOutput.Clear;
-  EndTime := Now + TIME_OUT / (24 * 60 * 60);
-  while AProcess.Running and (Now<EndTime) do
-  begin
-    // make sure we have room
-    BufferedOutput.SetSize(BytesRead + READ_BYTES);
-
-    // try reading it
-    {$IFNDEF VER2_0}
-    if AProcess.Output.NumBytesAvailable>0 then begin
-      n := AProcess.Output.Read((BufferedOutput.Memory + BytesRead)^, READ_BYTES);
-      Inc(BytesRead, n)
-    end
-    else
-      // no data, wait 100 ms
-      Sleep(100);
-    {$ELSE}
-    n := AProcess.Output.Read((BufferedOutput.Memory + BytesRead)^, READ_BYTES);
-    if n>0 then
-      Inc(BytesRead, n)
-    else
-      // no data, wait 100 ms
-      Sleep(100);
-    {$ENDIF}
-  end;
-  // read last part
-  repeat
-    // make sure we have room
-    BufferedOutput.SetSize(BytesRead + READ_BYTES);
-    // try reading it
-    {$IFNDEF VER2_0}
-    if AProcess.Output.NumBytesAvailable>0 then begin
-      n := AProcess.Output.Read((BufferedOutput.Memory + BytesRead)^, READ_BYTES);
-      Inc(BytesRead, n);
-    end
-    else
-      n := 0;
-    {$ELSE}
-    n := AProcess.Output.Read((BufferedOutput.Memory + BytesRead)^, READ_BYTES);
-    if n>0 then
-      Inc(BytesRead, n);
-    {$ENDIF}
-  until n <= 0;
-  BufferedOutput.SetSize(BytesRead);
-end;
-
 function FindProjectFile(APath: string):string;
 var
   SearchRec: TSearchRec;
@@ -159,6 +101,7 @@ procedure TBugTestCase.RunTestApp;
 var
   TestProcess : TProcess;
   ExeName: string;
+  OutputLines: TStringList;
 begin
   ExeName := ChangeFileExt(FProjectFile, GetExeExt);
   AssertTrue(ExeName + 'does not exist.', FileExists(ExeName));
@@ -168,7 +111,12 @@ begin
     TestProcess.Options := [poUsePipes];
     TestProcess.Execute;
     try
-      ReadOutput(TestProcess);
+      OutputLines := ReadOutput(TestProcess);
+      try
+        RunOutput.Assign(OutputLines);
+      finally
+        OutputLines.Free;
+      end;
       AssertFalse('TestProcess did not auto-terminate', TestProcess.Running);
     finally
       TestProcess.Terminate(0);
@@ -193,9 +141,8 @@ begin
   try
     ExpectedLines := TStringList.Create;
     ExpectedLines.LoadFromFile(ExpectedFileName);
-    BufferedOutput.Position := 0;
     ActualLines  := TStringList.Create;
-    ActualLines.LoadFromStream(BufferedOutput);
+    ActualLines.Assign(RunOutput);
     MinLineCount := min(ExpectedLines.Count, ActualLines.Count);
     for i := 0 to MinLineCount - 1 do begin
       AssertEquals('Output difference on line '+IntToStr(i+1),
@@ -253,9 +200,9 @@ end;
 
 initialization
   GatherTests;
-  BufferedOutput := TMemoryStream.Create;
+  RunOutput := TStringList.Create;
   
 finalization
-  FreeAndNil(BufferedOutput);
+  FreeAndNil(RunOutput);
 end.
 

test/runtestsgui.lpi

@@ -35,7 +35,7 @@
         <PackageName Value="CodeTools"/>
       </Item4>
     </RequiredPackages>
-    <Units Count="7">
+    <Units Count="8">
       <Unit0>
         <Filename Value="runtestsgui.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -71,17 +71,19 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="testfileproc"/>
       </Unit6>
+      <Unit7>
+        <Filename Value="bugtestcase.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="BugTestCase"/>
+      </Unit7>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="5"/>
+    <Version Value="8"/>
     <PathDelim Value="\"/>
     <SearchPaths>
       <OtherUnitFiles Value="bugs\"/>
     </SearchPaths>
-    <CodeGeneration>
-      <Generate Value="Faster"/>
-    </CodeGeneration>
     <Linking>
       <Debugging>
         <UseHeaptrc Value="True"/>

test/testglobals.pas

@@ -23,16 +23,68 @@ unit testglobals;
 interface
 
 uses
-  fpcunit, testregistry;
+  fpcunit, testregistry,
+  classes, sysutils, process;
 
 var
   Compiler: string;
   BugsTestSuite: TTestSuite;
-  
+
+// reads the output from a process and puts it in a memory stream
+function ReadOutput(AProcess:TProcess): TStringList;
 procedure AddToBugsTestSuite(ATest: TTest);
 
 implementation
 
+const
+  // Maximal number of bytes read from stream
+  READ_BYTES = 4096;
+  // Maximal run time for a test program
+  TIME_OUT = 30;
+
+function ReadOutput(AProcess:TProcess): TStringList;
+var
+  BytesRead: Integer;
+  n: Integer;
+  EndTime: TDateTime;
+  OutputStream: TMemoryStream;
+begin
+  OutputStream := TMemoryStream.Create;
+  BytesRead := 0;
+  EndTime := Now + TIME_OUT / (24 * 60 * 60);
+  while AProcess.Running and (Now<EndTime) do
+  begin
+    // make sure we have room
+    OutputStream.SetSize(BytesRead + READ_BYTES);
+
+    // try reading it
+    if AProcess.Output.NumBytesAvailable>0 then begin
+      n := AProcess.Output.Read((OutputStream.Memory + BytesRead)^, READ_BYTES);
+      Inc(BytesRead, n)
+    end
+    else
+      // no data, wait 100 ms
+      Sleep(100);
+  end;
+  // read last part
+  repeat
+    // make sure we have room
+    OutputStream.SetSize(BytesRead + READ_BYTES);
+    // try reading it
+    if AProcess.Output.NumBytesAvailable>0 then begin
+      n := AProcess.Output.Read((OutputStream.Memory + BytesRead)^, READ_BYTES);
+      Inc(BytesRead, n);
+    end
+    else
+      n := 0;
+  until n <= 0;
+  OutputStream.SetSize(BytesRead);
+  OutputStream.Position:=0;
+  Result := TStringList.Create;
+  Result.LoadFromStream(OutputStream);
+  OutputStream.Free;
+end;
+
 procedure AddToBugsTestSuite(ATest: TTest);
 begin
   BugsTestSuite.AddTest(ATest);

test/testlpi.pas

@@ -132,15 +132,17 @@ procedure TLpkTest.TestCompile;
 var
   LazBuildPath: string;
   LazBuild: TProcess;
+  OutputLines: TStrings;
 begin
   LazBuildPath := LazarusDir + 'lazbuild' + GetExeExt;
   AssertTrue(LazBuildPath + ' does not exist', FileExists(LazBuildPath));
   LazBuild := TProcess.Create(nil);
+  OutputLines := nil;
   try
     {$IFDEF windows}
-    LazBuild.Options := [poNewConsole];
+    LazBuild.Options := [poNewConsole, poUsePipes];
     {$ELSE}
-    LazBuild.Options := [poNoConsole];
+    LazBuild.Options := [poNoConsole, poUsePipes];
     {$ENDIF}
     LazBuild.ShowWindow := swoHIDE;
     LazBuild.CommandLine := LazBuildPath;
@@ -149,10 +151,14 @@ begin
     LazBuild.CommandLine := LazBuild.CommandLine + ' -B ' + FPath;
     LazBuild.CurrentDirectory := ExtractFileDir(FPath);
     LazBuild.Execute;
+    OutputLines := ReadOutput(LazBuild);
     LazBuild.WaitOnExit;
-    AssertEquals('Compilation failed: ExitCode', 0, LazBuild.ExitStatus);
+    if LazBuild.ExitStatus<>0 then
+      Fail(format('Compilation failed: ExitCode=%d%s%s',
+        [LazBuild.ExitStatus, LineEnding, OutputLines.Text]));
   finally
     LazBuild.Free;
+    OutputLines.Free;
   end;
 end;