Browse Source

Avoid long wait on this Windows OS specific test

Pierre Muller 4 months ago
parent
commit
8bd781aa4a
1 changed files with 20 additions and 5 deletions
  1. 20 5
      tests/webtbs/tw19325.pp

+ 20 - 5
tests/webtbs/tw19325.pp

@@ -2,6 +2,8 @@
 Program StrRedir;
 Program StrRedir;
 uses Classes, Process, Sysutils;
 uses Classes, Process, Sysutils;
 const MaxByte = 255;
 const MaxByte = 255;
+const MaxCount = 100;
+
 type
 type
       TStrBuf = packed record {As a way to read buffers into strings}
       TStrBuf = packed record {As a way to read buffers into strings}
       case Boolean of
       case Boolean of
@@ -13,10 +15,11 @@ type
 
 
 var
 var
    MoreProcess: TProcess;
    MoreProcess: TProcess;
-   readCount:   integer;
+   loopCount:   integer;
    strBuf:      TStrBuf;
    strBuf:      TStrBuf;
-
+   strBuf2:     TStrBuf;
 begin
 begin
+   loopCount:=0;
    MoreProcess := TProcess.Create(nil);
    MoreProcess := TProcess.Create(nil);
    MoreProcess.CommandLine := GetEnvironmentVariable('WINDIR')+'\system32\more.com';
    MoreProcess.CommandLine := GetEnvironmentVariable('WINDIR')+'\system32\more.com';
    MoreProcess.Options := [poUsePipes];
    MoreProcess.Options := [poUsePipes];
@@ -25,14 +28,26 @@ begin
    MoreProcess.Input.Write(strBuf.buf, strBuf.size);
    MoreProcess.Input.Write(strBuf.buf, strBuf.size);
    MoreProcess.CloseInput();
    MoreProcess.CloseInput();
    writeLn('Waiting...');    //This never ends
    writeLn('Waiting...');    //This never ends
-   while MoreProcess.Running do
+   while MoreProcess.Running and (loopCount<MaxCount) do
    begin
    begin
       Sleep(50);
       Sleep(50);
+      inc(loopCount);
       //strBuf.size := MoreProcess.Output.Read(strBuf.buf, 255);
       //strBuf.size := MoreProcess.Output.Read(strBuf.buf, 255);
    end;
    end;
-   writeLn('Wait finished.');
+   if not MoreProcess.Running then
+     writeLn('Wait finished.')
+   else
+     begin
+       MoreProcess.Terminate(1);
+     end;
    Sleep(100);
    Sleep(100);
-   strBuf.size := MoreProcess.Output.Read(strBuf.buf, 255);
+   strBuf2.size := MoreProcess.Output.Read(strBuf2.buf, 255);
    write(strBuf.txt);
    write(strBuf.txt);
+   if (strBuf.txt <> strBuf2.txt) or (loopCount=MaxCount)
+      or (MoreProcess.ExitCode<>0) then
+     begin
+       writeln('Test about inheritable pipe on Windows OS fails');
+       halt(1);
+     end;
    writeLn('------');
    writeLn('------');
 end.
 end.