mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-03 11:19:02 +02:00
* fix TBufferedFileStream.Seek(0,soBeginning) as proposed by Andrey Zubarev, resolves #38351
git-svn-id: trunk@48282 -
This commit is contained in:
parent
2b79b11744
commit
f4c74b6b09
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -18642,6 +18642,7 @@ tests/webtbs/tw38316.pp svneol=native#text/plain
|
||||
tests/webtbs/tw3833.pp svneol=native#text/plain
|
||||
tests/webtbs/tw38337.pp svneol=native#text/plain
|
||||
tests/webtbs/tw38339.pp svneol=native#text/plain
|
||||
tests/webtbs/tw38351.pp -text svneol=native#text/pascal
|
||||
tests/webtbs/tw3840.pp svneol=native#text/plain
|
||||
tests/webtbs/tw3841.pp svneol=native#text/plain
|
||||
tests/webtbs/tw3863.pp svneol=native#text/plain
|
||||
|
@ -812,7 +812,7 @@ begin
|
||||
lNewOffset:=FCacheStreamPosition+Offset;
|
||||
end;
|
||||
end;
|
||||
if lNewOffset>0 then begin
|
||||
if lNewOffset>=0 then begin
|
||||
FCacheStreamPosition:=lNewOffset;
|
||||
Result:=lNewOffset;
|
||||
end else begin
|
||||
|
33
tests/webtbs/tw38351.pp
Normal file
33
tests/webtbs/tw38351.pp
Normal file
@ -0,0 +1,33 @@
|
||||
{$MODE OBJFPC}
|
||||
{$APPTYPE CONSOLE}
|
||||
|
||||
uses Classes, BufStream, Sysutils;
|
||||
|
||||
procedure TestBufferedFileStream;
|
||||
var
|
||||
F: TStream;
|
||||
pf: File;
|
||||
begin
|
||||
Assign(pf,'tw38351.tmp');
|
||||
Rewrite(pf,1);
|
||||
Seek(pf,100);
|
||||
Close(pf);
|
||||
F := TBufferedFileStream.Create('tw38351.tmp', fmOpenRead);
|
||||
try
|
||||
Writeln(F.Position);
|
||||
if F.Position<>0 then
|
||||
halt(1);
|
||||
Writeln(F.Seek(0, soBeginning)); // TFileStream = 0, TBufferedFileStream = -1
|
||||
Writeln(F.Position);
|
||||
if F.Position<>0 then
|
||||
halt(1);
|
||||
finally
|
||||
F.Free;
|
||||
DeleteFile('tw38351.tmp');
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
TestBufferedFileStream;
|
||||
writeln('ok');
|
||||
end.
|
Loading…
Reference in New Issue
Block a user