paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-05 04:18:31 +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;
uses Classes, Process, Sysutils;
const MaxByte = 255;
const MaxCount = 100;
type
TStrBuf = packed record {As a way to read buffers into strings}
case Boolean of
@ -13,10 +15,11 @@ type
var
MoreProcess: TProcess;
readCount: integer;
loopCount: integer;
strBuf: TStrBuf;
strBuf2: TStrBuf;
begin
loopCount:=0;
MoreProcess := TProcess.Create(nil);
MoreProcess.CommandLine := GetEnvironmentVariable('WINDIR')+'\system32\more.com';
MoreProcess.Options := [poUsePipes];
@ -25,14 +28,26 @@ begin
MoreProcess.Input.Write(strBuf.buf, strBuf.size);
MoreProcess.CloseInput();
writeLn('Waiting...'); //This never ends
while MoreProcess.Running do
while MoreProcess.Running and (loopCount<MaxCount) do
begin
Sleep(50);
inc(loopCount);
//strBuf.size := MoreProcess.Output.Read(strBuf.buf, 255);
end;
writeLn('Wait finished.');
if not MoreProcess.Running then
writeLn('Wait finished.')
else
begin
MoreProcess.Terminate(1);
end;
Sleep(100);
strBuf.size := MoreProcess.Output.Read(strBuf.buf, 255);
strBuf2.size := MoreProcess.Output.Read(strBuf2.buf, 255);
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('------');
end.