Browse Source

* Replaced lot of duplicate code in fpc_Read_xxx procedures by call to internal CheckRead function.

git-svn-id: trunk@5877 -
yury 18 years ago
parent
commit
a95e47507b
1 changed files with 51 additions and 149 deletions
  1. 51 149
      rtl/inc/text.inc

+ 51 - 149
rtl/inc/text.inc

@@ -830,6 +830,28 @@ begin
 end;
 end;
 
 
 
 
+function CheckRead(var f:Text):Boolean;
+begin
+  CheckRead:=False;
+{ Check error and if file is open and load buf if empty }
+  If (InOutRes<>0) then
+    exit;
+  if (TextRec(f).mode<>fmInput) Then
+    begin
+      case TextRec(f).mode of
+        fmOutPut,fmAppend:
+          InOutRes:=104;
+        else
+          InOutRes:=103;
+      end;
+      exit;
+    end;
+  if TextRec(f).BufPos>=TextRec(f).BufEnd Then
+    FileFunc(TextRec(f).InOutFunc)(TextRec(f));
+  CheckRead:=True;
+end;
+
+
 Procedure fpc_Read_End(var f:Text);[Public,Alias:'FPC_READ_END']; iocheck; compilerproc;
 Procedure fpc_Read_End(var f:Text);[Public,Alias:'FPC_READ_END']; iocheck; compilerproc;
 begin
 begin
   if TextRec(f).FlushFunc<>nil then
   if TextRec(f).FlushFunc<>nil then
@@ -840,30 +862,15 @@ end;
 Procedure fpc_ReadLn_End(var f : Text);[Public,Alias:'FPC_READLN_END']; iocheck; compilerproc;
 Procedure fpc_ReadLn_End(var f : Text);[Public,Alias:'FPC_READLN_END']; iocheck; compilerproc;
 var prev: char;
 var prev: char;
 Begin
 Begin
-{ Check error and if file is open and load buf if empty }
-  If (InOutRes<>0) then
-   exit;
-  if (TextRec(f).mode<>fmInput) Then
-   begin
-     case TextRec(f).mode of
-      fmOutPut,fmAppend:
-        InOutRes:=104
-       else
-         InOutRes:=103;
-     end;
-     exit;
-   end;
-  if TextRec(f).BufPos>=TextRec(f).BufEnd Then
-   begin
-     FileFunc(TextRec(f).InOutFunc)(TextRec(f));
-     if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
-       { Flush if set }
-       begin
-         if (TextRec(f).FlushFunc<>nil) then
-           FileFunc(TextRec(f).FlushFunc)(TextRec(f));
-         exit;
-       end;
-   end;
+  If not CheckRead(f) then
+    exit;
+  if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
+    { Flush if set }
+    begin
+      if (TextRec(f).FlushFunc<>nil) then
+        FileFunc(TextRec(f).FlushFunc)(TextRec(f));
+      exit;
+    end;
   if CtrlZMarksEOF and (TextRec (F).BufPtr^ [TextRec (F).BufPos] = #26) then
   if CtrlZMarksEOF and (TextRec (F).BufPtr^ [TextRec (F).BufPos] = #26) then
    Exit;
    Exit;
   repeat
   repeat
@@ -919,19 +926,8 @@ Begin
     stop_chars[2]:=#26;
     stop_chars[2]:=#26;
   stop_chars[3]:=#0;
   stop_chars[3]:=#0;
   ReadPCharLen:=0;
   ReadPCharLen:=0;
-{ Check error and if file is open }
-  If (InOutRes<>0) then
-   exit;
-  if (TextRec(f).mode<>fmInput) Then
-   begin
-     case TextRec(f).mode of
-       fmOutPut,fmAppend:
-         InOutRes:=104
-       else
-         InOutRes:=103;
-     end;
-     exit;
-   end;
+  If not CheckRead(f) then
+    exit;
 { Read maximal until Maxlen is reached }
 { Read maximal until Maxlen is reached }
   sPos:=0;
   sPos:=0;
   end_of_string:=false;
   end_of_string:=false;
@@ -1016,29 +1012,13 @@ End;
 procedure fpc_Read_Text_Char(var f : Text; out c: char); iocheck; [Public,Alias:'FPC_READ_TEXT_CHAR'];compilerproc;
 procedure fpc_Read_Text_Char(var f : Text; out c: char); iocheck; [Public,Alias:'FPC_READ_TEXT_CHAR'];compilerproc;
 Begin
 Begin
   c:=#0;
   c:=#0;
-{ Check error and if file is open }
-  If (InOutRes<>0) then
-   exit;
-  if (TextRec(f).mode<>fmInput) Then
-   begin
-     case TextRec(f).mode of
-       fmOutPut,fmAppend:
-         InOutRes:=104
-       else
-         InOutRes:=103;
-     end;
-     exit;
-   end;
-{ Read next char or EOF }
+  If not CheckRead(f) then
+    exit;
   If TextRec(f).BufPos>=TextRec(f).BufEnd Then
   If TextRec(f).BufPos>=TextRec(f).BufEnd Then
-   begin
-     FileFunc(TextRec(f).InOutFunc)(TextRec(f));
-     If TextRec(f).BufPos>=TextRec(f).BufEnd Then
-       begin
-         c := #26;
-         exit;
-       end;
-   end;
+    begin
+      c := #26;
+      exit;
+    end;
   c:=TextRec(f).Bufptr^[TextRec(f).BufPos];
   c:=TextRec(f).Bufptr^[TextRec(f).BufPos];
   inc(TextRec(f).BufPos);
   inc(TextRec(f).BufPos);
 end;
 end;
@@ -1050,21 +1030,8 @@ var
   code : longint;
   code : longint;
 Begin
 Begin
   l:=0;
   l:=0;
-{ Leave if error or not open file, else check for empty buf }
-  If (InOutRes<>0) then
-   exit;
-  if (TextRec(f).mode<>fmInput) Then
-   begin
-     case TextRec(f).mode of
-       fmOutPut,fmAppend:
-         InOutRes:=104
-       else
-         InOutRes:=103;
-     end;
-     exit;
-   end;
-  If TextRec(f).BufPos>=TextRec(f).BufEnd Then
-   FileFunc(TextRec(f).InOutFunc)(TextRec(f));
+  If not CheckRead(f) then
+    exit;
   hs:='';
   hs:='';
   if IgnoreSpaces(f) then
   if IgnoreSpaces(f) then
    begin
    begin
@@ -1093,21 +1060,8 @@ var
   code : longint;
   code : longint;
 Begin
 Begin
   u:=0;
   u:=0;
-{ Leave if error or not open file, else check for empty buf }
-  If (InOutRes<>0) then
-   exit;
-  if (TextRec(f).mode<>fmInput) Then
-   begin
-     case TextRec(f).mode of
-       fmOutPut,fmAppend:
-         InOutRes:=104
-       else
-         InOutRes:=103;
-     end;
-     exit;
-   end;
-  If TextRec(f).BufPos>=TextRec(f).BufEnd Then
-   FileFunc(TextRec(f).InOutFunc)(TextRec(f));
+  If not CheckRead(f) then
+    exit;
   hs:='';
   hs:='';
   if IgnoreSpaces(f) then
   if IgnoreSpaces(f) then
    begin
    begin
@@ -1134,21 +1088,8 @@ var
   code : Word;
   code : Word;
 begin
 begin
   v:=0.0;
   v:=0.0;
-{ Leave if error or not open file, else check for empty buf }
-  If (InOutRes<>0) then
-   exit;
-  if (TextRec(f).mode<>fmInput) Then
-   begin
-     case TextRec(f).mode of
-       fmOutPut,fmAppend:
-         InOutRes:=104
-       else
-         InOutRes:=103;
-     end;
-     exit;
-   end;
-  If TextRec(f).BufPos>=TextRec(f).BufEnd Then
-   FileFunc(TextRec(f).InOutFunc)(TextRec(f));
+  If not CheckRead(f) then
+    exit;
   hs:='';
   hs:='';
   if IgnoreSpaces(f) then
   if IgnoreSpaces(f) then
    begin
    begin
@@ -1170,21 +1111,8 @@ var
   code : Word;
   code : Word;
 begin
 begin
   v:=0.0;
   v:=0.0;
-{ Leave if error or not open file, else check for empty buf }
-  If (InOutRes<>0) then
-   exit;
-  if (TextRec(f).mode<>fmInput) Then
-   begin
-     case TextRec(f).mode of
-       fmOutPut,fmAppend:
-         InOutRes:=104
-       else
-         InOutRes:=103;
-     end;
-     exit;
-   end;
-  If TextRec(f).BufPos>=TextRec(f).BufEnd Then
-   FileFunc(TextRec(f).InOutFunc)(TextRec(f));
+  If not CheckRead(f) then
+    exit;
   hs:='';
   hs:='';
   if IgnoreSpaces(f) then
   if IgnoreSpaces(f) then
    begin
    begin
@@ -1208,21 +1136,8 @@ var
   code : longint;
   code : longint;
 Begin
 Begin
   q:=0;
   q:=0;
-  { Leave if error or not open file, else check for empty buf }
-  If (InOutRes<>0) then
-   exit;
-  if (TextRec(f).mode<>fmInput) Then
-   begin
-     case TextRec(f).mode of
-       fmOutPut,fmAppend:
-         InOutRes:=104
-       else
-         InOutRes:=103;
-     end;
-     exit;
-   end;
-  If TextRec(f).BufPos>=TextRec(f).BufEnd Then
-   FileFunc(TextRec(f).InOutFunc)(TextRec(f));
+  If not CheckRead(f) then
+    exit;
   hs:='';
   hs:='';
   if IgnoreSpaces(f) then
   if IgnoreSpaces(f) then
    begin
    begin
@@ -1243,21 +1158,8 @@ var
   code : Longint;
   code : Longint;
 Begin
 Begin
   i:=0;
   i:=0;
-{ Leave if error or not open file, else check for empty buf }
-  If (InOutRes<>0) then
-   exit;
-  if (TextRec(f).mode<>fmInput) Then
-   begin
-     case TextRec(f).mode of
-       fmOutPut,fmAppend:
-         InOutRes:=104
-       else
-         InOutRes:=103;
-     end;
-     exit;
-   end;
-  If TextRec(f).BufPos>=TextRec(f).BufEnd Then
-   FileFunc(TextRec(f).InOutFunc)(TextRec(f));
+  If not CheckRead(f) then
+    exit;
   hs:='';
   hs:='';
   if IgnoreSpaces(f) then
   if IgnoreSpaces(f) then
    begin
    begin