--- Merging r46853 into '.':

U    rtl/inc/text.inc
--- Recording mergeinfo for merge of r46853 into '.':
 U   .
--- Merging r46864 into '.':
G    rtl/inc/text.inc
--- Recording mergeinfo for merge of r46864 into '.':
 G   .
--- Merging r46946 into '.':
G    rtl/inc/text.inc
A    tests/test/units/system/tseekeof.pp
--- Recording mergeinfo for merge of r46946 into '.':
 G   .
--- Merging r47542 into '.':
U    rtl/go32v2/sysutils.pp
U    rtl/msdos/sysutils.pp
U    rtl/watcom/sysutils.pp
--- Recording mergeinfo for merge of r47542 into '.':
 G   .
--- Merging r47543 into '.':
G    rtl/msdos/sysutils.pp
--- Recording mergeinfo for merge of r47543 into '.':
 G   .
--- Merging r47544 into '.':
G    rtl/go32v2/sysutils.pp
--- Recording mergeinfo for merge of r47544 into '.':
 G   .

# revisions: 46853,46864,46946,47542,47543,47544
r46853 | hajny | 2020-09-12 01:43:32 +0200 (Sat, 12 Sep 2020) | 1 line
Changed paths:
   M /trunk/rtl/inc/text.inc

  * fix for bug #37716 by Andrey 'Croco' Stolyarov
r46864 | hajny | 2020-09-14 07:30:59 +0200 (Mon, 14 Sep 2020) | 1 line
Changed paths:
   M /trunk/rtl/inc/text.inc

  * fix for problem with commit 46853
r46946 | hajny | 2020-09-24 21:33:28 +0200 (Thu, 24 Sep 2020) | 1 line
Changed paths:
   M /trunk/rtl/inc/text.inc
   A /trunk/tests/test/units/system/tseekeof.pp

  * simplified version of SeekEof for improved TP/BP/Delphi compatibility by Andrey 'Croco' Stolyarov as fix for #37716, plus a new test for testing the compatibility
r47542 | hajny | 2020-11-24 01:25:20 +0100 (Tue, 24 Nov 2020) | 1 line
Changed paths:
   M /trunk/rtl/go32v2/sysutils.pp
   M /trunk/rtl/msdos/sysutils.pp
   M /trunk/rtl/watcom/sysutils.pp

  + provided sysbeep for DOS targets
r47543 | hajny | 2020-11-24 01:27:06 +0100 (Tue, 24 Nov 2020) | 1 line
Changed paths:
   M /trunk/rtl/msdos/sysutils.pp

  * reverted a change not belonging to the previous commit
r47544 | hajny | 2020-11-24 01:29:08 +0100 (Tue, 24 Nov 2020) | 1 line
Changed paths:
   M /trunk/rtl/go32v2/sysutils.pp

  * reverted a change not belonging to the previous commit

git-svn-id: branches/fixes_3_2@47907 -

.gitattributes

@@ -15532,6 +15532,7 @@ tests/test/units/system/tresb.res -text
 tests/test/units/system/tresext.pp svneol=native#text/plain
 tests/test/units/system/trnd1.pp svneol=native#text/pascal
 tests/test/units/system/tround.pp svneol=native#text/plain
+tests/test/units/system/tseekeof.pp svneol=native#text/plain
 tests/test/units/system/tseg.pp svneol=native#text/plain
 tests/test/units/system/tsetstr.pp svneol=native#text/plain
 tests/test/units/system/tsetstr2.pp svneol=native#text/plain

rtl/go32v2/sysutils.pp

@@ -670,8 +670,16 @@ end ;
                               Misc Functions
 ****************************************************************************}
 
+const
+  BeepChars: array [1..2] of char = #7'$';
+
 procedure sysBeep;
+var
+  Regs: Registers;
 begin
+  Regs.dx := Ofs (BeepChars);
+  Regs.ah := 9;
+  MsDos (Regs);
 end;
 
 

rtl/inc/text.inc

@@ -440,11 +440,6 @@ End;
 
 
 Function SeekEof (Var t : Text) : Boolean;
-var
-  oldfilepos : Int64;
-  oldbufpos, oldbufend : SizeInt;
-  reads: longint;
-  isdevice: boolean;
 Begin
   If (InOutRes<>0) then
    exit(true);
@@ -456,31 +451,12 @@ Begin
       InOutRes:=103;
      exit(true);
    end;
-  { try to save the current position in the file, seekeof() should not move }
-  { the current file position (JM)                                          }
-  oldbufpos := TextRec(t).BufPos;
-  oldbufend := TextRec(t).BufEnd;
-  reads := 0;
-  oldfilepos := -1;
-  isdevice := Do_IsDevice(TextRec(t).handle);
   repeat
     If TextRec(t).BufPos>=TextRec(t).BufEnd Then
      begin
-       { signal that the we will have to do a seek }
-       inc(reads);
-       if not isdevice and
-          (reads = 1) then
-         begin
-           oldfilepos := Do_FilePos(TextRec(t).handle) - TextRec(t).BufEnd;
-           InOutRes:=0;
-         end;
        FileFunc(TextRec(t).InOutFunc)(TextRec(t));
        If TextRec(t).BufPos>=TextRec(t).BufEnd Then
         begin
-          { if we only did a read in which we didn't read anything, the }
-          { old buffer is still valid and we can simply restore the     }
-          { pointers (JM)                                               }
-          dec(reads);
           SeekEof := true;
           break;
         end;
@@ -502,24 +478,6 @@ Begin
     end;
    inc(TextRec(t).BufPos);
   until false;
-  { restore file position if not working with a device }
-  if not isdevice then
-    { if we didn't modify the buffer, simply restore the BufPos and BufEnd  }
-    { (the latter because it's now probably set to zero because nothing was }
-    {  was read anymore)                                                    }
-    if (reads = 0) then
-      begin
-        TextRec(t).BufPos:=oldbufpos;
-        TextRec(t).BufEnd:=oldbufend;
-      end
-    { otherwise return to the old filepos and reset the buffer }
-    else
-      begin
-        do_seek(TextRec(t).handle,oldfilepos);
-        InOutRes:=0;
-        FileFunc(TextRec(t).InOutFunc)(TextRec(t));
-        TextRec(t).BufPos:=oldbufpos;
-      end;
 End;
 
 

rtl/msdos/sysutils.pp

@@ -654,8 +654,16 @@ end ;
                               Misc Functions
 ****************************************************************************}
 
+const
+  BeepChars: array [1..2] of char = #7'$';
+
 procedure sysBeep;
+var
+  Regs: Registers;
 begin
+  Regs.dx := Ofs (BeepChars);
+  Regs.ah := 9;
+  MsDos (Regs);
 end;
 
 

rtl/watcom/sysutils.pp

@@ -654,6 +654,17 @@ end ;
                               Misc Functions
 ****************************************************************************}
 
+const
+  BeepChars: array [1..2] of char = #7'$';
+
+procedure sysBeep;
+var
+  Regs: Registers;
+begin
+  Regs.dx := Ofs (BeepChars);
+  Regs.ah := 9;
+  MsDos (Regs);
+end;
 
 {****************************************************************************
                               Locale Functions
@@ -898,6 +909,7 @@ Initialization
   InitExceptions;       { Initialize exceptions. OS independent }
   InitInternational;    { Initialize internationalization settings }
   InitDelay;
+  OnBeep:=@SysBeep;
 Finalization
   FreeTerminateProcs;
   DoneExceptions;

tests/test/units/system/tseekeof.pp

@@ -0,0 +1,72 @@
+program TSeekEof;
+{$DEFINE DEBUG}
+{$I+}
+
+{$IFNDEF FPC}
+uses
+ Dos;
+{$ENDIF FPC}
+
+const
+ Line1 = '  123 23 45   ';
+ Line2 = '                                            '#9#9#9'              ';
+
+var
+ T: text;
+ F: file;
+ B: byte;
+ SeekEofReached: boolean;
+
+begin
+ Assign (T, 'tseekeof.txt');
+ Assign (F, 'tseekeof.txt');
+ Rewrite (T);
+ WriteLn (T, Line1);
+ WriteLn (T, Line2);
+ WriteLn (T, Line2);
+ WriteLn (T, Line2);
+ WriteLn (T, Line2);
+ Close (T);
+ TextRec (T).BufSize := 5;
+(* Buffer size decreased to make sure that the buffer needs to be read more often *)
+ Reset (T);
+{$IFDEF DEBUG}
+ WriteLn ('Before: BufPos = ', TextRec (T).BufPos, ', BufEnd = ', TextRec (T).BufEnd);
+{$ENDIF DEBUG}
+ SeekEofReached := SeekEof (T);
+{$IFDEF DEBUG}
+ WriteLn ('After: BufPos = ', TextRec (T).BufPos, ', BufEnd = ', TextRec (T).BufEnd);
+{$ENDIF DEBUG}
+ while not (SeekEofReached) do
+  begin
+   Read (T, B);
+{$IFDEF DEBUG}
+   WriteLn ('Read: ', B);
+{$ENDIF DEBUG}
+{$IFDEF DEBUG}
+ WriteLn ('Before: BufPos = ', TextRec (T).BufPos, ', BufEnd = ', TextRec (T).BufEnd);
+{$ENDIF DEBUG}
+   SeekEofReached := SeekEof (T);
+{$IFDEF DEBUG}
+ WriteLn ('After: BufPos = ', TextRec (T).BufPos, ', BufEnd = ', TextRec (T).BufEnd);
+{$ENDIF DEBUG}
+  end;
+{$IFDEF DEBUG}
+ WriteLn ('SeekEof reached');
+{$ENDIF DEBUG}
+ if not (Eof (T)) then
+  begin
+{$IFDEF DEBUG}
+   WriteLn ('File not at EOF after SeekEof!');
+{$ENDIF DEBUG}
+   Close (T);
+   Erase (F);
+   Halt (1);
+  end
+ else
+{$IFDEF DEBUG}
+  WriteLn ('File at EOF after SeekEof');
+{$ENDIF DEBUG}
+ Close (T);
+ Erase (F);
+end.