paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 00:28:05 +02:00
Code Issues Packages Projects Releases Wiki Activity

Avoid long wait on this Windows OS specific test

Browse Source
This commit is contained in:
Pierre Muller 2025-03-24 17:08:26 +00:00
parent 6314d69c40
commit 8bd781aa4a
1 changed files with 20 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
tests/webtbs/tw19325.pp
View File

@ -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.