paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-24 22:10:42 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Each IOCheck routine now check InOutRes before, just like TP

Browse Source
This commit is contained in:
carl 1998-07-02 12:14:56 +00:00
parent a787487de6
commit 2f83875419
1 changed files with 49 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
rtl/inc/text.inc
View File

@ -104,6 +104,7 @@ end;
Procedure Close(var t : Text);[Public,Alias: 'CLOSE_TEXT',IOCheck]; Procedure Close(var t : Text);[Public,Alias: 'CLOSE_TEXT',IOCheck];
Begin Begin
if InOutRes <> 0 then Exit;
If (TextRec(t).mode<>fmClosed) Then If (TextRec(t).mode<>fmClosed) Then
Begin Begin
{ Write pending buffer } { Write pending buffer }
@ -136,24 +137,28 @@ End;
Procedure Rewrite(var t : Text);[IOCheck]; Procedure Rewrite(var t : Text);[IOCheck];
Begin Begin
If InOutRes <> 0 then exit;
OpenText(t,fmOutput,1); OpenText(t,fmOutput,1);
End; End;
Procedure Reset(var t : Text);[IOCheck]; Procedure Reset(var t : Text);[IOCheck];
Begin Begin
If InOutRes <> 0 then exit;
OpenText(t,fmInput,0); OpenText(t,fmInput,0);
End; End;
Procedure Append(var t : Text);[IOCheck]; Procedure Append(var t : Text);[IOCheck];
Begin Begin
If InOutRes <> 0 then exit;
OpenText(t,fmAppend,1); OpenText(t,fmAppend,1);
End; End;
Procedure Flush(var t : Text);[IOCheck]; Procedure Flush(var t : Text);[IOCheck];
Begin Begin
If InOutRes <> 0 then exit;
If TextRec(t).mode<>fmOutput Then If TextRec(t).mode<>fmOutput Then
exit; exit;
{ Not the flushfunc but the inoutfunc should be used, becuase that { Not the flushfunc but the inoutfunc should be used, becuase that
@ -164,6 +169,7 @@ End;
Procedure Erase(var t:Text);[IOCheck]; Procedure Erase(var t:Text);[IOCheck];
Begin Begin
If InOutRes <> 0 then exit;
If TextRec(t).mode=fmClosed Then If TextRec(t).mode=fmClosed Then
Do_Erase(PChar(@TextRec(t).Name)); Do_Erase(PChar(@TextRec(t).Name));
End; End;
@ -171,6 +177,7 @@ End;
Procedure Rename(var t : text;p:pchar);[IOCheck]; Procedure Rename(var t : text;p:pchar);[IOCheck];
Begin Begin
If InOutRes <> 0 then exit;
If TextRec(t).mode=fmClosed Then If TextRec(t).mode=fmClosed Then
Begin Begin
Do_Rename(PChar(@TextRec(t).Name),p); Do_Rename(PChar(@TextRec(t).Name),p);
@ -183,6 +190,7 @@ Procedure Rename(var t : Text;const s : string);[IOCheck];
var var
p : array[0..255] Of Char; p : array[0..255] Of Char;
Begin Begin
If InOutRes <> 0 then exit;
Move(s[1],p,Length(s)); Move(s[1],p,Length(s));
p[Length(s)]:=#0; p[Length(s)]:=#0;
Rename(t,Pchar(@p)); Rename(t,Pchar(@p));
@ -193,6 +201,7 @@ Procedure Rename(var t : Text;c : char);[IOCheck];
var var
p : array[0..1] Of Char; p : array[0..1] Of Char;
Begin Begin
If InOutRes <> 0 then exit;
p[0]:=c; p[0]:=c;
p[1]:=#0; p[1]:=#0;
Rename(t,Pchar(@p)); Rename(t,Pchar(@p));
@ -201,6 +210,7 @@ End;
Function Eof(Var t: Text): Boolean;[IOCheck]; Function Eof(Var t: Text): Boolean;[IOCheck];
Begin Begin
If InOutRes <> 0 then exit;
{$IFNDEF EXTENDED_EOF} {$IFNDEF EXTENDED_EOF}
{$IFDEF EOF_CTRLZ} {$IFDEF EOF_CTRLZ}
Eof:=TextRec(t).Buffer[TextRec(t).BufPos]=#26; Eof:=TextRec(t).Buffer[TextRec(t).BufPos]=#26;
@ -408,6 +418,7 @@ const
eol : array[0..1] of char=(#13,#10); eol : array[0..1] of char=(#13,#10);
{$ENDIF SHORT_LINEBREAK} {$ENDIF SHORT_LINEBREAK}
begin begin
If InOutRes <> 0 then exit;
{ Write EOL } { Write EOL }
WriteBuffer(f,eol,eollen); WriteBuffer(f,eol,eollen);
{ Flush } { Flush }
@ -418,6 +429,7 @@ end;
Procedure Write_Str(Len : Longint;var f : TextRec;const s : String);[Public,Alias: 'WRITE_TEXT_STRING']; Procedure Write_Str(Len : Longint;var f : TextRec;const s : String);[Public,Alias: 'WRITE_TEXT_STRING'];
Begin Begin
If InOutRes <> 0 then exit;
If f.mode<>fmOutput Then If f.mode<>fmOutput Then
exit; exit;
If Len>Length(s) Then If Len>Length(s) Then
@ -432,6 +444,7 @@ Procedure Write_Array(Len : Longint;var f : TextRec;const p : array00);[Public,A
var var
ArrayLen : longint; ArrayLen : longint;
Begin Begin
If InOutRes <> 0 then exit;
If f.mode<>fmOutput Then If f.mode<>fmOutput Then
exit; exit;
ArrayLen:=StrLen(p); ArrayLen:=StrLen(p);
@ -445,6 +458,7 @@ Procedure Write_PChar(Len : Longint;var f : TextRec;p : PChar);[Public,Alias: 'W
var var
PCharLen : longint; PCharLen : longint;
Begin Begin
If InOutRes <> 0 then exit;
If f.mode<>fmOutput Then If f.mode<>fmOutput Then
exit; exit;
PCharLen:=StrLen(p); PCharLen:=StrLen(p);
@ -458,6 +472,7 @@ Procedure Write_LongInt(Len : Longint;var t : TextRec;l : Longint);[Public,Alias
var var
s : String; s : String;
Begin Begin
If InOutRes <> 0 then exit;
Str(l,s); Str(l,s);
Write_Str(Len,t,s); Write_Str(Len,t,s);
End; End;
@ -467,6 +482,7 @@ Procedure Write_Real(fixkomma,Len : Longint;var t : TextRec;r : real);[Public,Al
var var
s : String; s : String;
Begin Begin
If InOutRes <> 0 then exit;
{$ifdef i386} {$ifdef i386}
Str_real(Len,fixkomma,r,rt_s64real,s); Str_real(Len,fixkomma,r,rt_s64real,s);
{$else} {$else}
@ -480,18 +496,21 @@ Procedure Write_Cardinal(Len : Longint;var t : TextRec;l : cardinal);[Public,Ali
var var
s : String; s : String;
Begin Begin
If InOutRes <> 0 then exit;
Str(L,s); Str(L,s);
Write_Str(Len,t,s); Write_Str(Len,t,s);
End; End;
{$ifdef SUPPORT_SINGLE}
Procedure Write_Single(fixkomma,Len : Longint;var t : TextRec;r : single);[Public,Alias: 'WRITE_TEXT_SINGLE']; Procedure Write_Single(fixkomma,Len : Longint;var t : TextRec;r : single);[Public,Alias: 'WRITE_TEXT_SINGLE'];
var var
s : String; s : String;
Begin Begin
If InOutRes <> 0 then exit;
Str_real(Len,fixkomma,r,rt_s32real,s); Str_real(Len,fixkomma,r,rt_s32real,s);
Write_Str(Len,t,s); Write_Str(Len,t,s);
End; End;
{$endif SUPPORT_SINGLE}
{$ifdef SUPPORT_EXTENDED} {$ifdef SUPPORT_EXTENDED}
@ -499,6 +518,7 @@ Procedure Write_Extended(fixkomma,Len : Longint;var t : TextRec;r : extended);[P
var var
s : String; s : String;
Begin Begin
If InOutRes <> 0 then exit;
Str_real(Len,fixkomma,r,rt_s80real,s); Str_real(Len,fixkomma,r,rt_s80real,s);
Write_Str(Len,t,s); Write_Str(Len,t,s);
End; End;
@ -510,6 +530,7 @@ Procedure Write_Comp(fixkomma,Len : Longint;var t : TextRec;r : comp);[Public,Al
var var
s : String; s : String;
Begin Begin
If InOutRes <> 0 then exit;
Str_real(Len,fixkomma,r,rt_s64bit,s); Str_real(Len,fixkomma,r,rt_s64bit,s);
Write_Str(Len,t,s); Write_Str(Len,t,s);
End; End;
@ -520,6 +541,7 @@ Procedure Write_Fixed(fixkomma,Len : Longint;var t : TextRec;r : fixed);[Public,
var var
s : String; s : String;
Begin Begin
If InOutRes <> 0 then exit;
Str_real(Len,fixkomma,r,rt_f32bit,s); Str_real(Len,fixkomma,r,rt_f32bit,s);
Write_Str(Len,t,s); Write_Str(Len,t,s);
End; End;
@ -527,6 +549,7 @@ End;
Procedure Write_Boolean(Len : Longint;var t : TextRec;b : Boolean);[Public,Alias: 'WRITE_TEXT_BOOLEAN']; Procedure Write_Boolean(Len : Longint;var t : TextRec;b : Boolean);[Public,Alias: 'WRITE_TEXT_BOOLEAN'];
Begin Begin
If InOutRes <> 0 then exit;
{ Can't use array[boolean] because b can be >0 ! } { Can't use array[boolean] because b can be >0 ! }
if b then if b then
Write_Str(Len,t,'TRUE') Write_Str(Len,t,'TRUE')
@ -537,6 +560,7 @@ End;
Procedure Write_Char(Len : Longint;var t : TextRec;c : Char);[Public,Alias: 'WRITE_TEXT_CHAR']; Procedure Write_Char(Len : Longint;var t : TextRec;c : Char);[Public,Alias: 'WRITE_TEXT_CHAR'];
Begin Begin
If InOutRes <> 0 then exit;
If t.mode<>fmOutput Then If t.mode<>fmOutput Then
exit; exit;
If Len>1 Then If Len>1 Then
@ -553,6 +577,7 @@ Procedure w(var t : TextRec);[Public,Alias: 'WRITELN_TEXT'];
var var
hs : String; hs : String;
Begin Begin
If InOutRes <> 0 then exit;
{$IFDEF SHORT_LINEBREAK} {$IFDEF SHORT_LINEBREAK}
hs:=#10; hs:=#10;
{$ELSE} {$ELSE}
@ -669,6 +694,7 @@ end;
Procedure ReadLn_End(var f : TextRec);[Public,Alias: 'READLN_END']; Procedure ReadLn_End(var f : TextRec);[Public,Alias: 'READLN_END'];
Begin Begin
If InOutRes <> 0 then exit;
if not OpenInput(f) then if not OpenInput(f) then
exit; exit;
{ Read until a linebreak } { Read until a linebreak }
@ -692,6 +718,7 @@ var
Begin Begin
{ Delete the string } { Delete the string }
s:=''; s:='';
If InOutRes <> 0 then exit;
if not OpenInput(f) then if not OpenInput(f) then
exit; exit;
Temp:=f.BufPos; Temp:=f.BufPos;
@ -731,6 +758,7 @@ End;
Procedure Read_Char(var f : TextRec;var c : Char);[Public,Alias: 'READ_TEXT_CHAR']; Procedure Read_Char(var f : TextRec;var c : Char);[Public,Alias: 'READ_TEXT_CHAR'];
Begin Begin
c:=#0; c:=#0;
If InOutRes <> 0 then exit;
if not OpenInput(f) then if not OpenInput(f) then
exit; exit;
If f.BufPos>=f.BufEnd Then If f.BufPos>=f.BufEnd Then
@ -748,6 +776,7 @@ var
Begin Begin
{ Delete the string } { Delete the string }
s^:=#0; s^:=#0;
If InOutRes <> 0 then exit;
p:=s; p:=s;
if not OpenInput(f) then if not OpenInput(f) then
exit; exit;
@ -781,6 +810,7 @@ var
Begin Begin
{ Delete the string } { Delete the string }
s[0]:=#0; s[0]:=#0;
If InOutRes <> 0 then exit;
p:=pchar(@s); p:=pchar(@s);
if not OpenInput(f) then if not OpenInput(f) then
exit; exit;
@ -814,6 +844,7 @@ var
base : longint; base : longint;
Begin Begin
l:=0; l:=0;
If InOutRes <> 0 then exit;
hs:=''; hs:='';
if not OpenInput(f) then if not OpenInput(f) then
exit; exit;
@ -829,8 +860,9 @@ Procedure Read_Integer(var f : TextRec;var l : Integer);[Public,Alias: 'READ_TEX
var var
ll : Longint; ll : Longint;
Begin Begin
Read_Longint(f,ll);
l:=0; l:=0;
If InOutRes <> 0 then exit;
Read_Longint(f,ll);
If (ll<-32768) or (ll>32767) Then If (ll<-32768) or (ll>32767) Then
RunError(106); RunError(106);
l:=ll; l:=ll;
@ -841,8 +873,9 @@ Procedure Read_Word(var f : TextRec;var l : Word);[Public,Alias: 'READ_TEXT_WORD
var var
ll : Longint; ll : Longint;
Begin Begin
Read_Longint(f,ll);
l:=0; l:=0;
If InOutRes <> 0 then exit;
Read_Longint(f,ll);
If (ll<0) or (ll>$ffff) Then If (ll<0) or (ll>$ffff) Then
RunError(106); RunError(106);
l:=ll; l:=ll;
@ -853,8 +886,9 @@ Procedure Read_Byte(var f : TextRec;var l : byte);[Public,Alias: 'READ_TEXT_BYTE
var var
ll : Longint; ll : Longint;
Begin Begin
Read_Longint(f,ll);
l:=0; l:=0;
If InOutRes <> 0 then exit;
Read_Longint(f,ll);
If (ll<0) or (ll>255) Then If (ll<0) or (ll>255) Then
RunError(106); RunError(106);
l:=ll; l:=ll;
@ -865,8 +899,9 @@ Procedure Read_Shortint(var f : TextRec;var l : shortint);[Public,Alias: 'READ_T
var var
ll : Longint; ll : Longint;
Begin Begin
Read_Longint(f,ll);
l:=0; l:=0;
If InOutRes <> 0 then exit;
Read_Longint(f,ll);
If (ll<-128) or (ll>127) Then If (ll<-128) or (ll>127) Then
RunError(106); RunError(106);
l:=ll; l:=ll;
@ -880,6 +915,7 @@ var
base : longint; base : longint;
Begin Begin
l:=0; l:=0;
If InOutRes <> 0 then exit;
hs:=''; hs:='';
if not OpenInput(f) then if not OpenInput(f) then
exit; exit;
@ -897,6 +933,7 @@ var
code : Word; code : Word;
Begin Begin
d:=0.0; d:=0.0;
If InOutRes <> 0 then exit;
hs:=''; hs:='';
if not OpenInput(f) then if not OpenInput(f) then
exit; exit;
@ -935,6 +972,7 @@ var
code : Word; code : Word;
Begin Begin
d:=0.0; d:=0.0;
If InOutRes <> 0 then exit;
hs:=''; hs:='';
if not OpenInput(f) then if not OpenInput(f) then
exit; exit;
@ -974,6 +1012,7 @@ var
code : Word; code : Word;
Begin Begin
d:=comp(0.0); d:=comp(0.0);
If InOutRes <> 0 then exit;
hs:=''; hs:='';
if not OpenInput(f) then if not OpenInput(f) then
exit; exit;
@ -1009,6 +1048,7 @@ End;
{$IFNDEF NEW_READWRITE} {$IFNDEF NEW_READWRITE}
Procedure r(var f : TextRec);[Public,Alias: 'READLN_TEXT']; Procedure r(var f : TextRec);[Public,Alias: 'READLN_TEXT'];
Begin Begin
If InOutRes <> 0 then exit;
if not OpenInput(f) then if not OpenInput(f) then
exit; exit;
while (f.BufPos<f.BufEnd) do while (f.BufPos<f.BufEnd) do
@ -1047,7 +1087,10 @@ end;
{ {
$Log$ $Log$
Revision 1.13 1998-07-01 15:30:00 peter Revision 1.14 1998-07-02 12:14:56 carl
+ Each IOCheck routine now check InOutRes before, just like TP
Revision 1.13 1998/07/01 15:30:00 peter
* better readln/writeln * better readln/writeln
Revision 1.12 1998/07/01 14:48:10 carl Revision 1.12 1998/07/01 14:48:10 carl