paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 20:19:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Error detection of streams

Browse Source
This commit is contained in:
carl 2000-02-06 19:58:24 +00:00
parent b6d9988f22
commit e8f58e804f
1 changed files with 39 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
utils/ptop.pp
View File

@ -7,7 +7,7 @@ Program PtoP;
the Free Pascal development team the Free Pascal development team
Pascal pretty print program Pascal pretty print program
See the file COPYING.FPC, included in this distribution, See the file COPYING.FPC, included in this distribution,
for details about the copyright. for details about the copyright.
@ -23,13 +23,15 @@ Var
Infilename,OutFileName,ConfigFile : String; Infilename,OutFileName,ConfigFile : String;
BeVerbose : Boolean; BeVerbose : Boolean;
TheIndent,TheBufSize,TheLineSize : Integer; TheIndent,TheBufSize,TheLineSize : Integer;
Function StrToInt(Const S : String) : Integer; Function StrToInt(Const S : String) : Integer;
Var Code : integer; Var Code : integer;
Int : integer;
begin begin
Val(S,StrToInt,Code); Val(S,int,Code);
StrToInt := int;
If Code<>0 then StrToInt:=0; If Code<>0 then StrToInt:=0;
end; end;
@ -57,7 +59,9 @@ Var S : PBufStream;
begin begin
S:=New(PBufStream,Init(ConfigFile,stCreate,255)); S:=New(PBufStream,Init(ConfigFile,stCreate,255));
GeneratecfgFile(S); GeneratecfgFile(S);
{$ifndef tp}
S^.Close; S^.Close;
{$endif}
S^.Done; S^.Done;
end; end;
@ -114,8 +118,31 @@ Var DiagS : PMemoryStream;
PPrinter : TPrettyPrinter; PPrinter : TPrettyPrinter;
P : Pchar; P : Pchar;
i : longint; i : longint;
Procedure StreamErrorProcedure(Var S: TStream); FAR;
Begin
If S.Status = StError then
WriteLn('ERROR: General Access failure. Halting');
If S.Status = StInitError then
WriteLn('ERROR: Cannot Init Stream. Halting. ');
If S.Status = StReadError then
WriteLn('ERROR: Read beyond end of Stream. Halting');
If S.Status = StWriteError then
WriteLn('ERROR: Cannot expand Stream. Halting');
If S.Status = StGetError then
WriteLn('ERROR: Get of Unregistered type. Halting');
If S.Status = StPutError then
WriteLn('ERROR: Put of Unregistered type. Halting');
end;
begin begin
{$IFDEF TP}
StreamError:= @StreamErrorProcedure;
{$ELSE}
StreamError:= StreamErrorProcedure;
{$ENDIF}
ProcessOpts; ProcessOpts;
If (Length(InfileName)=0) or (Length(OutFileName)=0) Then If (Length(InfileName)=0) or (Length(OutFileName)=0) Then
Usage; Usage;
@ -144,8 +171,12 @@ begin
getmem (P,I+1); getmem (P,I+1);
DiagS^.Read(P[0],I); DiagS^.Read(P[0],I);
P[I]:=#0; P[I]:=#0;
{$ifndef tp}
Writeln (stderr,P); Writeln (stderr,P);
Flush(stderr); Flush(stderr);
{$else}
Writeln (P);
{$endif}
DiagS^.Done; DiagS^.Done;
end; end;
If Assigned(CfgS) then If Assigned(CfgS) then
@ -156,7 +187,10 @@ end.
{ {
$Log$ $Log$
Revision 1.3 2000-01-07 16:46:04 daniel Revision 1.4 2000-02-06 19:58:24 carl
+ Error detection of streams
Revision 1.3 2000/01/07 16:46:04 daniel
* copyright 2000 * copyright 2000
Revision 1.2 1999/07/08 21:17:10 michael Revision 1.2 1999/07/08 21:17:10 michael