mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 15:47:53 +02:00
+ added a test for Get/SetTextAutoFlush feature
git-svn-id: trunk@49325 -
This commit is contained in:
Tomas Hajny
parent
9f6651fdb7
commit
0d37e0e0f8
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -16368,6 +16368,7 @@ tests/test/units/system/tstring.pp svneol=native#text/plain
|
||||
tests/test/units/system/ttrig.pas svneol=native#text/plain
|
||||
tests/test/units/system/ttrig.pp svneol=native#text/plain
|
||||
tests/test/units/system/ttrunc.pp svneol=native#text/plain
|
||||
tests/test/units/system/ttxtflsh.pp svneol=native#text/plain
|
||||
tests/test/units/system/tval.inc svneol=native#text/plain
|
||||
tests/test/units/system/tval.pp svneol=native#text/plain
|
||||
tests/test/units/system/tval1.pp svneol=native#text/plain
|
||||
|
||||
189
tests/test/units/system/ttxtflsh.pp
Normal file
189
tests/test/units/system/ttxtflsh.pp
Normal file
@ -0,0 +1,189 @@
|
||||
{$DEFINE VERBOSE}
|
||||
{$DEFINE DEBUG}
|
||||
(* Define the following if the test will be run manually in a console *)
|
||||
(* (no output redirection) - otherwise the test will fail for some targets. *)
|
||||
{ $DEFINE CONSOLE}
|
||||
{$I-}
|
||||
uses
|
||||
Dos;
|
||||
var
|
||||
T: text;
|
||||
IOR: integer;
|
||||
TElapsed1, TElapsed2: int64;
|
||||
I: longint;
|
||||
const
|
||||
TestFName = 'ttxtflsh.txt';
|
||||
NoTestFName = '_NoSuchF.FFF';
|
||||
{$IF DEFINED(OS2) or DEFINED(WINDOWS) or DEFINED(GO32V2) or DEFINED(WATCOM) or DEFINED(MSDOS)}
|
||||
ConsoleDeviceName = 'CON';
|
||||
{$DEFINE TESTCONSOLEOK}
|
||||
{$ELSE}
|
||||
{ {$IF DEFINED(UNIX)}
|
||||
(* I don't know whether there's a device on Unix allowing to enforce output to console even if standard output is redirected for the given process... *)
|
||||
ConsoleDeviceName = '/dev/tty';
|
||||
{$DEFINE TESTCONSOLEOK}
|
||||
{$ELSE}
|
||||
}
|
||||
{$IFDEF CONSOLE}
|
||||
ConsoleDeviceName = '';
|
||||
{$DEFINE TESTCONSOLEOK}
|
||||
{$ENDIF CONSOLE}
|
||||
{ $ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
procedure ChkErr (Err: boolean; MsgOK, MsgErr: string; N: byte);
|
||||
begin
|
||||
if Err then
|
||||
begin
|
||||
if IOResult = 0 then
|
||||
begin
|
||||
end;
|
||||
WriteLn ('Error: ', MsgErr);
|
||||
{$IFDEF VERBOSE}
|
||||
WriteLn ('Exit value: ', N);
|
||||
{$ENDIF VERBOSE}
|
||||
Halt (N);
|
||||
end
|
||||
{$IFDEF VERBOSE}
|
||||
else
|
||||
WriteLn (MsgOK)
|
||||
{$ENDIF VERBOSE}
|
||||
;
|
||||
end;
|
||||
|
||||
function PerfTest: int64;
|
||||
var
|
||||
T1: int64;
|
||||
begin
|
||||
T1 := GetMsCount;
|
||||
for I := 0 to 50000 do
|
||||
Write (T, I);
|
||||
PerfTest := GetMsCount - T1;
|
||||
ChkErr (IOResult <> 0, 'Test text output successful.',
|
||||
'Test text output failed!', 255);
|
||||
end;
|
||||
|
||||
begin
|
||||
Assign (T, NoTestFName);
|
||||
Reset (T);
|
||||
SetTextAutoFlush (T, true);
|
||||
ChkErr (GetTextAutoFlush (T),
|
||||
'Set/GetTextAutoFlush call correctly ignored with non-zero InOutRes.',
|
||||
'Set/GetTextAutoFlush call not ignored in spite of non-zero InOutRes!', 1);
|
||||
if IOResult <> 0 then
|
||||
begin
|
||||
end;
|
||||
SetTextAutoFlush (T, true);
|
||||
IOR := IOResult;
|
||||
{$IFDEF DEBUG}
|
||||
WriteLn (StdErr, IOR);
|
||||
{$ENDIF DEBUG}
|
||||
ChkErr (IOR <> 103,
|
||||
'SetTextAutoFlush correctly errors out with expected RTE if file not open.',
|
||||
'SetTextAutoFlush does not finish with expected RTE if file not open!', 2);
|
||||
Assign (T, TestFName);
|
||||
Rewrite (T);
|
||||
ChkErr (IOResult <> 0, 'Test file ' + TestFName + ' created successfully.',
|
||||
'Test file ' + TestFName + ' creation failed!', 3);
|
||||
Close (T);
|
||||
Reset (T);
|
||||
SetTextAutoFlush (T, true);
|
||||
IOR := IOResult;
|
||||
{$IFDEF DEBUG}
|
||||
WriteLn (StdErr, IOR);
|
||||
{$ENDIF DEBUG}
|
||||
ChkErr (IOR <> 105,
|
||||
'SetTextAutoFlush correctly errors out if file not open for writing.',
|
||||
'SetTextAutoFlush does not finish with expected RTE if file not open for writing!', 4);
|
||||
Close (T);
|
||||
Rewrite (T);
|
||||
{$IFDEF DEBUG}
|
||||
WriteLn (StdErr, Longint (TextRec(T).FlushFunc));
|
||||
{$ENDIF DEBUG}
|
||||
ChkErr (GetTextAutoFlush (T) or (IOResult <> 0),
|
||||
'GetTextAutoFlush returns expected default value for a regular file.',
|
||||
'GetTextAutoFlush returns unexpected default value for a regular file!', 5);
|
||||
SetTextAutoFlush (T, true);
|
||||
{$IFDEF DEBUG}
|
||||
WriteLn (StdErr, Longint (TextRec(T).FlushFunc));
|
||||
{$ENDIF DEBUG}
|
||||
ChkErr (not (GetTextAutoFlush (T)) or (IOResult <> 0),
|
||||
'GetTextAutoFlush returns expected modified value after SetTextAutoFlush.',
|
||||
'GetTextAutoFlush does not return expected modified value after SetTextAutoFlush!', 6);
|
||||
TElapsed1 := PerfTest;
|
||||
{$IFDEF DEBUG}
|
||||
WriteLn (StdErr, 'Run 1: ', TElapsed1, ' ms');
|
||||
{$ENDIF DEBUG}
|
||||
Close (T);
|
||||
Rewrite (T);
|
||||
{$IFDEF DEBUG}
|
||||
WriteLn (StdErr, Longint (TextRec(T).FlushFunc));
|
||||
{$ENDIF DEBUG}
|
||||
ChkErr (GetTextAutoFlush (T) or (IOResult <> 0),
|
||||
'GetTextAutoFlush returns expected default value after file reopening.',
|
||||
'GetTextAutoFlush does not return expected default value after file reopening!', 7);
|
||||
TElapsed2 := PerfTest;
|
||||
{$IFDEF DEBUG}
|
||||
WriteLn (StdErr, 'Run 2: ', TElapsed2, ' ms');
|
||||
{$ENDIF DEBUG}
|
||||
ChkErr (TElapsed1 <= TElapsed2,
|
||||
'Output performance lower with enforced flushing as expected.',
|
||||
'Output performance not lower with enforced flushing!', 11);
|
||||
Close (T);
|
||||
Append (T);
|
||||
{$IFDEF DEBUG}
|
||||
WriteLn (StdErr, Longint (TextRec(T).FlushFunc));
|
||||
{$ENDIF DEBUG}
|
||||
ChkErr (GetTextAutoFlush (T) or (IOResult <> 0),
|
||||
'GetTextAutoFlush returns expected default value after file reopening for appending.',
|
||||
'GetTextAutoFlush does not return expected default value after file reopening for appending!', 13);
|
||||
Close (T);
|
||||
Erase (T);
|
||||
if IOResult <> 0 then
|
||||
begin
|
||||
end;
|
||||
|
||||
{$IFDEF TESTCONSOLEOK}
|
||||
Assign (T, ConsoleDeviceName);
|
||||
Rewrite (T);
|
||||
{$IFDEF DEBUG}
|
||||
WriteLn (StdErr, Longint (TextRec(T).FlushFunc));
|
||||
{$ENDIF DEBUG}
|
||||
ChkErr (not (GetTextAutoFlush (T)) or (IOResult <> 0),
|
||||
'GetTextAutoFlush returns expected default value for console output.',
|
||||
'GetTextAutoFlush returns unexpected default value for console output!', 8);
|
||||
SetTextAutoFlush (T, false);
|
||||
{$IFDEF DEBUG}
|
||||
WriteLn (StdErr, Longint (TextRec(T).FlushFunc));
|
||||
{$ENDIF DEBUG}
|
||||
ChkErr (GetTextAutoFlush (T) or (IOResult <> 0),
|
||||
'GetTextAutoFlush returns expected modified value after SetTextAutoFlush with console.',
|
||||
'GetTextAutoFlush does not return expected modified value after SetTextAutoFlush with console!', 9);
|
||||
TElapsed1 := PerfTest;
|
||||
{$IFDEF DEBUG}
|
||||
WriteLn (StdErr, 'Run 1: ', TElapsed1, ' ms');
|
||||
{$ENDIF DEBUG}
|
||||
Close (T);
|
||||
Rewrite (T);
|
||||
{$IFDEF DEBUG}
|
||||
WriteLn (StdErr, Longint (TextRec(T).FlushFunc));
|
||||
{$ENDIF DEBUG}
|
||||
ChkErr (not (GetTextAutoFlush (T)) or (IOResult <> 0),
|
||||
'GetTextAutoFlush returns expected default value after file reopening for console.',
|
||||
'GetTextAutoFlush returns unexpected default value after file reopening for console!', 10);
|
||||
TElapsed2 := PerfTest;
|
||||
{$IFDEF DEBUG}
|
||||
WriteLn (StdErr, 'Run 2: ', TElapsed2, ' ms');
|
||||
{$ENDIF DEBUG}
|
||||
ChkErr (TElapsed1 >= TElapsed2,
|
||||
'Output performance higher with disabled flushing as expected.',
|
||||
'Output performance not higher with disabled flushing!', 12);
|
||||
Close (T);
|
||||
|
||||
{$ENDIF TESTCONSOLEOK}
|
||||
|
||||
{$IFDEF VERBOSE}
|
||||
WriteLn ('TTxtFlsh finished successfully.');
|
||||
{$ENDIF VERBOSE}
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user