From b02470468b5dfe8bea64a872dab205b39babb81d Mon Sep 17 00:00:00 2001
From: florian <florian@freepascal.org>
Date: Sun, 13 Oct 2019 11:37:37 +0000
Subject: [PATCH]   * handle off by one in FilePos due to the filled buffer in
 iso mode, resolves #40850

git-svn-id: trunk@43188 -
---
 .gitattributes          |  1 +
 rtl/inc/iso7185.pp      | 13 ++++++++++++-
 tests/webtbs/tw40850.pp | 43 +++++++++++++++++++++++++++++++++++++++++
 3 files changed, 56 insertions(+), 1 deletion(-)
 create mode 100644 tests/webtbs/tw40850.pp

diff --git a/.gitattributes b/.gitattributes
index 75915f0dfd..926494798f 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -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
diff --git a/rtl/inc/iso7185.pp b/rtl/inc/iso7185.pp
index f61b4f1285..6d2536a647 100644
--- a/rtl/inc/iso7185.pp
+++ b/rtl/inc/iso7185.pp
@@ -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 }
diff --git a/tests/webtbs/tw40850.pp b/tests/webtbs/tw40850.pp
new file mode 100644
index 0000000000..093a275450
--- /dev/null
+++ b/tests/webtbs/tw40850.pp
@@ -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.