paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 00:47:52 +02:00
Code Issues Packages Projects Releases Wiki Activity

--- Merging r46853 into '.':

Browse Source 
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 -
This commit is contained in:
marco 2020-12-30 14:07:54 +00:00
parent 4995677b0f
commit 83f7e7e3dc
6 changed files with 101 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

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

8
rtl/go32v2/sysutils.pp
View File

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

42
rtl/inc/text.inc
View File

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

8
rtl/msdos/sysutils.pp
View File

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

12
rtl/watcom/sysutils.pp
View File

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

72
tests/test/units/system/tseekeof.pp Normal file
View File

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