mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-17 06:39:38 +02:00
+ added tests for recent stream modifications
git-svn-id: trunk@18247 -
This commit is contained in:
parent
3e4469937c
commit
a9034af414
3
.gitattributes
vendored
3
.gitattributes
vendored
@ -11721,6 +11721,8 @@ tests/webtbs/tw1950.pp svneol=native#text/plain
|
||||
tests/webtbs/tw19548.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw1964.pp svneol=native#text/plain
|
||||
tests/webtbs/tw19700.pp svneol=native#text/plain
|
||||
tests/webtbs/tw19851a.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw19851b.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw19864.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw19874.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw19910.pp svneol=native#text/pascal
|
||||
@ -12552,6 +12554,7 @@ tests/webtbs/uw18087b.pp svneol=native#text/pascal
|
||||
tests/webtbs/uw18909a.pp svneol=native#text/pascal
|
||||
tests/webtbs/uw18909b.pp svneol=native#text/pascal
|
||||
tests/webtbs/uw19159.pp svneol=native#text/pascal
|
||||
tests/webtbs/uw19851.pp svneol=native#text/pascal
|
||||
tests/webtbs/uw2004.inc svneol=native#text/plain
|
||||
tests/webtbs/uw2040.pp svneol=native#text/plain
|
||||
tests/webtbs/uw2266a.inc svneol=native#text/plain
|
||||
|
32
tests/webtbs/tw19851a.pp
Normal file
32
tests/webtbs/tw19851a.pp
Normal file
@ -0,0 +1,32 @@
|
||||
{ %norun }
|
||||
{ Test seeking in TIOStream.
|
||||
|
||||
!!! Input to standard in must begin with:
|
||||
abcdefghijklmnopqrstuvwxyz1*
|
||||
where * represents optional additional characters (can be anything).
|
||||
|
||||
!!! It is recommended that this be tested interactively from the keyboard too. Run the
|
||||
test program, type the test string, and press Enter.
|
||||
|
||||
See ExerciseStream.pas for exit codes.
|
||||
}
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
program tiostreamseek;
|
||||
|
||||
uses
|
||||
iostream,
|
||||
uw19851;
|
||||
|
||||
var
|
||||
AIOStream: TIOStream;
|
||||
|
||||
begin
|
||||
AIOStream := TIOStream.Create(iosInput);
|
||||
try
|
||||
ExitCode := Test(AIOStream);
|
||||
finally
|
||||
AIOStream.Free;
|
||||
end;
|
||||
end.
|
6
tests/webtbs/tw19851b.pp
Normal file
6
tests/webtbs/tw19851b.pp
Normal file
@ -0,0 +1,6 @@
|
||||
uses
|
||||
sysutils;
|
||||
|
||||
begin
|
||||
executeprocess('cmd.exe','/c echo abcdefghijklmnopqrstuvwxyz1 | tw19851a');
|
||||
end.
|
105
tests/webtbs/uw19851.pp
Normal file
105
tests/webtbs/uw19851.pp
Normal file
@ -0,0 +1,105 @@
|
||||
{ %norun }
|
||||
{ Exit code:
|
||||
= 0 - pass
|
||||
= 1 - incorrect input for test (first three characters are not abc)
|
||||
>= 2 - fail (but can be caused by incorrect test input too)
|
||||
}
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
unit uw19851;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes;
|
||||
|
||||
function Test(AStream: TStream): Integer;
|
||||
|
||||
implementation
|
||||
|
||||
function Test(AStream: TStream): Integer;
|
||||
var
|
||||
AString: string;
|
||||
begin
|
||||
try
|
||||
Result := 0;
|
||||
SetLength(AString, 3);
|
||||
|
||||
// Test reading first 3 characters
|
||||
AStream.ReadBuffer(AString[1], Length(AString));
|
||||
if AString <> 'abc' then
|
||||
Exit(1);
|
||||
if AStream.Position <> 3 then
|
||||
Exit(2);
|
||||
|
||||
// Test 32-bit seek from current
|
||||
if AStream.Seek(Longint(3), soFromCurrent) <> 6 then
|
||||
Exit(3);
|
||||
|
||||
// Read & make sure position is correct
|
||||
AStream.ReadBuffer(AString[1], Length(AString));
|
||||
if AString <> 'ghi' then
|
||||
Exit(4);
|
||||
if AStream.Position <> AStream.Seek(Longint(0), soFromCurrent) then
|
||||
Exit(5);
|
||||
if AStream.Position <> AStream.Seek(Int64(0), soCurrent) then
|
||||
Exit(6);
|
||||
if AStream.Position <> 9 then
|
||||
Exit(7);
|
||||
|
||||
// Test 64-bit seek from current
|
||||
if AStream.Seek(Int64(3), soCurrent) <> 12 then
|
||||
Exit(8);
|
||||
|
||||
// Read & make sure position is correct
|
||||
AStream.ReadBuffer(AString[1], Length(AString));
|
||||
if AString <> 'mno' then
|
||||
Exit(9);
|
||||
if AStream.Position <> 15 then
|
||||
Exit(10);
|
||||
if AStream.Seek(Longint(0), soFromCurrent) <> 15 then
|
||||
Exit(11);
|
||||
if AStream.Seek(Int64(15), soBeginning) <> 15 then
|
||||
Exit(12);
|
||||
if AStream.Seek(Longint(15), soFromBeginning) <> 15 then
|
||||
Exit(13);
|
||||
if AStream.Seek(Int64(0), soCurrent) <> 15 then
|
||||
Exit(14);
|
||||
|
||||
// Test 32-bit seek from beginning
|
||||
if AStream.Seek(Longint(18), soFromBeginning) <> 18 then
|
||||
Exit(15);
|
||||
|
||||
// Read & make sure position is correct
|
||||
AStream.ReadBuffer(AString[1], Length(AString));
|
||||
if AString <> 'stu' then
|
||||
Exit(16);
|
||||
if AStream.Position <> 21 then
|
||||
Exit(17);
|
||||
|
||||
// Test 64-bit seek from beginning
|
||||
if AStream.Seek(Int64(24), soBeginning) <> 24 then
|
||||
Exit(18);
|
||||
if AStream.Position <> 24 then
|
||||
Exit(19);
|
||||
if AStream.Seek(Longint(0), soFromCurrent) <> 24 then
|
||||
Exit(20);
|
||||
|
||||
// Read & make sure position is correct
|
||||
AStream.ReadBuffer(AString[1], Length(AString));
|
||||
if AString <> 'yz1' then
|
||||
Exit(21);
|
||||
if AStream.Position <> 27 then
|
||||
Exit(22);
|
||||
finally
|
||||
{on E: EStreamError do
|
||||
begin
|
||||
Result := 23;
|
||||
WriteLn(E.Message);
|
||||
end;}
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
Loading…
Reference in New Issue
Block a user