mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-06 08:56:16 +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/tw3477.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw3478.pp svneol=native#text/plain
|
tests/webtbs/tw3478.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw3479.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/tw3489.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw3490.pp svneol=native#text/plain
|
tests/webtbs/tw3490.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw3491.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 Get(Var f: TypedFile);
|
||||||
Procedure Put(Var f: TypedFile);
|
Procedure Put(Var f: TypedFile);
|
||||||
|
Procedure Seek(var f:TypedFile;Pos:Int64);
|
||||||
|
|
||||||
Function Eof(var f:TypedFile): Boolean;
|
Function Eof(var f:TypedFile): Boolean;
|
||||||
|
|
||||||
@ -193,13 +194,13 @@ unit iso7185;
|
|||||||
procedure Get(var f:TypedFile);[IOCheck];
|
procedure Get(var f:TypedFile);[IOCheck];
|
||||||
Begin
|
Begin
|
||||||
if not(eof(f)) then
|
if not(eof(f)) then
|
||||||
BlockRead(f,(pbyte(@f)+sizeof(FileRec))^,1)
|
BlockRead(f,(pbyte(@f)+sizeof(FileRec))^,1);
|
||||||
End;
|
End;
|
||||||
|
|
||||||
|
|
||||||
Procedure Put(var f:TypedFile);[IOCheck];
|
Procedure Put(var f:TypedFile);[IOCheck];
|
||||||
begin
|
begin
|
||||||
BlockWrite(f,(pbyte(@f)+sizeof(FileRec))^,1)
|
BlockWrite(f,(pbyte(@f)+sizeof(FileRec))^,1);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -208,6 +209,23 @@ unit iso7185;
|
|||||||
Eof:=FileRec(f)._private[1]=1;
|
Eof:=FileRec(f)._private[1]=1;
|
||||||
End;
|
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
|
begin
|
||||||
{ we shouldn't do this because it might confuse user programs, but for now it
|
{ 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 }
|
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