mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-15 23:59:30 +02:00
* handle off by one in FilePos due to the filled buffer in iso mode, resolves #40850
git-svn-id: trunk@43188 -
This commit is contained in:
parent
33c4a5dda7
commit
b02470468b
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -17922,6 +17922,7 @@ tests/webtbs/tw4058.pp svneol=native#text/plain
|
||||
tests/webtbs/tw4068.pp svneol=native#text/plain
|
||||
tests/webtbs/tw4078.pp svneol=native#text/plain
|
||||
tests/webtbs/tw4080.pp svneol=native#text/plain
|
||||
tests/webtbs/tw40850.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw4086.pp svneol=native#text/plain
|
||||
tests/webtbs/tw4089.pp svneol=native#text/plain
|
||||
tests/webtbs/tw4093.pp svneol=native#text/plain
|
||||
|
@ -48,6 +48,7 @@ unit iso7185;
|
||||
Procedure Get(Var f: TypedFile);
|
||||
Procedure Put(Var f: TypedFile);
|
||||
Procedure Seek(var f:TypedFile;Pos:Int64);
|
||||
Function FilePos(var f:TypedFile):Int64;
|
||||
|
||||
Function Eof(var f:TypedFile): Boolean;
|
||||
|
||||
@ -210,7 +211,7 @@ unit iso7185;
|
||||
End;
|
||||
|
||||
|
||||
Procedure Seek(var f:TypedFile;Pos:Int64);
|
||||
Procedure Seek(var f:TypedFile;Pos:Int64);[IOCheck];
|
||||
Begin
|
||||
System.Seek(f,Pos);
|
||||
if (FileRec(f).mode=fmInOut) or
|
||||
@ -226,6 +227,16 @@ unit iso7185;
|
||||
end;
|
||||
End;
|
||||
|
||||
|
||||
Function FilePos(var f:TypedFile):Int64;[IOCheck];
|
||||
Begin
|
||||
FilePos:=System.FilePos(f);
|
||||
{ in case of reading a file, the buffer is always filled, so the result of Do_FilePos is off by one }
|
||||
if (FileRec(f).mode=fmInOut) or
|
||||
(FileRec(f).mode=fmInput) then
|
||||
dec(FilePos);
|
||||
End;
|
||||
|
||||
begin
|
||||
{ we shouldn't do this because it might confuse user programs, but for now it
|
||||
is good enough to get pretty unique tmp file names }
|
||||
|
43
tests/webtbs/tw40850.pp
Normal file
43
tests/webtbs/tw40850.pp
Normal file
@ -0,0 +1,43 @@
|
||||
{$mode iso}
|
||||
program mytest;
|
||||
|
||||
procedure my_test1;
|
||||
type byte_file = file of byte;
|
||||
|
||||
var test_file : byte_file;
|
||||
test_text : text;
|
||||
loc : integer;
|
||||
len : integer;
|
||||
my_bits : byte;
|
||||
pos : int64;
|
||||
begin
|
||||
assign(test_text, 'tw40850.data');
|
||||
rewrite(test_text);
|
||||
write(test_text,'0123456789'#10);
|
||||
close(test_text);
|
||||
loc := 9;
|
||||
assign(test_file, 'tw40850.data');
|
||||
reset(test_file);
|
||||
len := filesize(test_file);
|
||||
writeln('File size: ', len);
|
||||
seek(test_file, loc);
|
||||
if EOF(test_file) then
|
||||
writeln('EOF reached');
|
||||
pos := filepos(test_file);
|
||||
if pos<>9 then
|
||||
halt(1);
|
||||
writeln('File position: ', pos);
|
||||
read(test_file, my_bits);
|
||||
if my_bits<>57 then
|
||||
halt(1);
|
||||
writeln(my_bits);
|
||||
read(test_file, my_bits);
|
||||
writeln(my_bits);
|
||||
if my_bits<>10 then
|
||||
halt(1);
|
||||
close(test_file);
|
||||
writeln('ok');
|
||||
end;
|
||||
begin
|
||||
my_test1;
|
||||
end.
|
Loading…
Reference in New Issue
Block a user