mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 23:48:15 +02:00
+ seek for typefiles in iso mode, resolves #34848
git-svn-id: trunk@40850 -
This commit is contained in:
parent
b223d1c304
commit
dd072ce76b
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -16474,6 +16474,7 @@ tests/webtbs/tw3474.pp svneol=native#text/plain
|
||||
tests/webtbs/tw3477.pp svneol=native#text/plain
|
||||
tests/webtbs/tw3478.pp svneol=native#text/plain
|
||||
tests/webtbs/tw3479.pp svneol=native#text/plain
|
||||
tests/webtbs/tw34848.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw3489.pp svneol=native#text/plain
|
||||
tests/webtbs/tw3490.pp svneol=native#text/plain
|
||||
tests/webtbs/tw3491.pp svneol=native#text/plain
|
||||
|
@ -47,6 +47,7 @@ unit iso7185;
|
||||
|
||||
Procedure Get(Var f: TypedFile);
|
||||
Procedure Put(Var f: TypedFile);
|
||||
Procedure Seek(var f:TypedFile;Pos:Int64);
|
||||
|
||||
Function Eof(var f:TypedFile): Boolean;
|
||||
|
||||
@ -193,13 +194,13 @@ unit iso7185;
|
||||
procedure Get(var f:TypedFile);[IOCheck];
|
||||
Begin
|
||||
if not(eof(f)) then
|
||||
BlockRead(f,(pbyte(@f)+sizeof(FileRec))^,1)
|
||||
BlockRead(f,(pbyte(@f)+sizeof(FileRec))^,1);
|
||||
End;
|
||||
|
||||
|
||||
Procedure Put(var f:TypedFile);[IOCheck];
|
||||
begin
|
||||
BlockWrite(f,(pbyte(@f)+sizeof(FileRec))^,1)
|
||||
BlockWrite(f,(pbyte(@f)+sizeof(FileRec))^,1);
|
||||
end;
|
||||
|
||||
|
||||
@ -208,6 +209,23 @@ unit iso7185;
|
||||
Eof:=FileRec(f)._private[1]=1;
|
||||
End;
|
||||
|
||||
|
||||
Procedure Seek(var f:TypedFile;Pos:Int64);
|
||||
Begin
|
||||
System.Seek(f,Pos);
|
||||
if (FileRec(f).mode=fmInOut) or
|
||||
(FileRec(f).mode=fmInput) then
|
||||
begin
|
||||
if FilePos(f)<FileSize(f) then
|
||||
begin
|
||||
FileRec(f)._private[1]:=0;
|
||||
Get(f);
|
||||
end
|
||||
else
|
||||
FileRec(f)._private[1]:=1;
|
||||
end;
|
||||
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 }
|
||||
|
41
tests/webtbs/tw34848.pp
Normal file
41
tests/webtbs/tw34848.pp
Normal file
@ -0,0 +1,41 @@
|
||||
{$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, 'tw34848.data');
|
||||
rewrite(test_text);
|
||||
write(test_text,'0123456789'#10);
|
||||
close(test_text);
|
||||
loc := 9;
|
||||
assign(test_file, 'tw34848.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);
|
||||
writeln('File position: ', pos);
|
||||
read(test_file, my_bits);
|
||||
writeln(my_bits);
|
||||
if my_bits<>57 then
|
||||
halt(1);
|
||||
read(test_file, my_bits);
|
||||
writeln(my_bits);
|
||||
if my_bits<>10 then
|
||||
halt(1);
|
||||
close(test_file);
|
||||
end;
|
||||
begin
|
||||
my_test1;
|
||||
writeln('ok');
|
||||
end.
|
Loading…
Reference in New Issue
Block a user