Jelajahi Sumber

+ seek for typefiles in iso mode, resolves #34848

git-svn-id: trunk@40850 -
florian 6 tahun lalu
induk
melakukan
dd072ce76b
3 mengubah file dengan 62 tambahan dan 2 penghapusan
  1. 1 0
      .gitattributes
  2. 20 2
      rtl/inc/iso7185.pp
  3. 41 0
      tests/webtbs/tw34848.pp

+ 1 - 0
.gitattributes

@@ -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

+ 20 - 2
rtl/inc/iso7185.pp

@@ -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 - 0
tests/webtbs/tw34848.pp

@@ -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.