From 83f7e7e3dcab1ff4f81274cdbb27cdbdf2017290 Mon Sep 17 00:00:00 2001 From: marco Date: Wed, 30 Dec 2020 14:07:54 +0000 Subject: [PATCH] --- 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 | 1 + rtl/go32v2/sysutils.pp | 8 ++++ rtl/inc/text.inc | 42 ----------------- rtl/msdos/sysutils.pp | 8 ++++ rtl/watcom/sysutils.pp | 12 +++++ tests/test/units/system/tseekeof.pp | 72 +++++++++++++++++++++++++++++ 6 files changed, 101 insertions(+), 42 deletions(-) create mode 100644 tests/test/units/system/tseekeof.pp diff --git a/.gitattributes b/.gitattributes index b348c8b2c6..d086c77db9 100644 --- a/.gitattributes +++ b/.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 diff --git a/rtl/go32v2/sysutils.pp b/rtl/go32v2/sysutils.pp index 133f31c6a7..8bf95605da 100644 --- a/rtl/go32v2/sysutils.pp +++ b/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; diff --git a/rtl/inc/text.inc b/rtl/inc/text.inc index 0ae0f4aac0..023fde3bc8 100644 --- a/rtl/inc/text.inc +++ b/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; diff --git a/rtl/msdos/sysutils.pp b/rtl/msdos/sysutils.pp index 8e2fedd4a8..3578fe7272 100644 --- a/rtl/msdos/sysutils.pp +++ b/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; diff --git a/rtl/watcom/sysutils.pp b/rtl/watcom/sysutils.pp index d21db8d6b5..87f526eb8b 100644 --- a/rtl/watcom/sysutils.pp +++ b/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; diff --git a/tests/test/units/system/tseekeof.pp b/tests/test/units/system/tseekeof.pp new file mode 100644 index 0000000000..028fd3f7ee --- /dev/null +++ b/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.