home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / MKERR101.ZIP / ERRTEST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-08-04  |  4.2 KB  |  148 lines
  1. program errtest;
  2.  
  3. uses mkerr;
  4.  
  5. var f:text;
  6.     b:byte;
  7.  
  8. procedure doerr2(i:integer);
  9. begin
  10.  if errset then begin
  11.   writeln('fail again, next try.. ',i);
  12.   dec(i);
  13.   if i<1 then
  14.      errfree;
  15.  end;
  16.  writeln(f,'DoErr2 i=',i);
  17.  errfree;
  18. end;
  19.  
  20. procedure doerr1;
  21. begin
  22.  if errset then begin
  23.   writeln(' Something went wrong.. exiting ');
  24.   errfree;
  25.   exit;
  26.  end;
  27.  writeln('DoErr1, calling DoErr2..');
  28.  doerr2(3);
  29.  errfree;
  30. end;
  31.  
  32. function doerr3(s:string;b:byte):byte;
  33. begin
  34.  doerr3:=9;
  35.  writeln('DoErr3. clearing error device . . ');
  36.  errfree;
  37.  close(f);
  38. end;
  39.  
  40. begin
  41.  if errset then begin
  42.   writeln('Program failure, retrying..');
  43.   assign(f,'CON');
  44.   rewrite(f);
  45.  end;
  46.  doerr1;
  47.  doerr2(4);
  48.  b:=doerr3('99',33);
  49.  writeln('Err3 closed file f. And error handler.');
  50.  if errset then begin
  51.   writeln('Well, seems someone already shut down the file');
  52.   continue;
  53.  end;
  54.  close(f);
  55.  errfree;
  56.  close(f); {This is just to show you runtime errors occurs when}
  57.            {error device is inactive..}
  58.  done;
  59. end.
  60.  
  61. ERRTEST:
  62. line program                   errordevice
  63. 40: begin                     inactive
  64. 41:  if errset..               SET 1. level error handler. return false
  65. 46:  doerr1;
  66. 22:   if errset..               SET 2. level error handler. return false
  67. 27:   writeln..
  68. 28:   doerr2(3)
  69. 10:    if errset..               SET 3. level error handler. return false
  70. 16:    writeln(f,..               ERROR. File not open. go to last handler
  71. 11:     writeln('fail..
  72. 12:     dec(i)
  73. 13:     if i<1 then   {i=2}
  74. 15:    end;
  75. 16:    writeln(f,..               ERROR. File not open. go to last handler
  76. 11:     writeln('fail..
  77. 12:     dec(i)
  78. 13:     if i<1 then   {i=1}
  79. 15:    end;
  80. 16:    writeln(f,..               ERROR. File not open. go to last handler
  81. 11:     writeln('fail..
  82. 12:     dec(i)
  83. 13:     if i<1 then   {i=0}
  84. 14:      errfree;                CLEAR 3. level error handler, active is 2.
  85. 15:    end;
  86. 16:    writeln(f,..              ERROR. File not open. go to last handler
  87. 23:    writeln(' Someth..
  88. 24:    errfree;                 CLEAR 2. level error handler, active is 1.
  89. 25:    exit;
  90. 30:   end; {of doerr1}
  91. 47:   doerr2(4)
  92. 10:    if errset..              SET 2. level error handler. return false
  93. 16:    writeln(f,..              ERROR. File not open. go to last handler
  94. 11:     writeln('fail..
  95. 12:     dec(i)
  96. 13:     if i<1 then   {i=3}
  97. 15:    end;
  98. 16:    writeln(f,..              ERROR. File not open. go to last handler
  99. 11:     writeln('fail..
  100. 12:     dec(i)
  101. 13:     if i<1 then   {i=2}
  102. 15:    end;
  103. 16:    writeln(f,..              ERROR. File not open. go to last handler
  104. 11:     writeln('fail..
  105. 12:     dec(i)
  106. 13:     if i<1 then   {i=1}
  107. 15:    end;
  108. 16:    writeln(f,..              ERROR. File not open. go to last handler
  109. 11:     writeln('fail..
  110. 12:     dec(i)
  111. 13:     if i<1 then   {i=0}
  112. 14:      errfree;               CLEAR 2. level error handler, active is 1.
  113. 15:    end;
  114. 16:    writeln(f,..            ERROR. File not open. go to last handler
  115. 42:   writeln('Progr..
  116. 43:   assign..
  117. 44:   rewrite..
  118. 45:  end;
  119.  
  120. 46:  doerr1;
  121. 22:   if errset..              SET 2. level error handler. return false
  122. 27:   writeln..
  123. 28:   doerr2(3)
  124. 10:    if errset..              SET 3. level error handler. return false
  125. 16:    writeln(f,..              OK. File is open.
  126. 17:    errfree;                 CLEAR 3. level error handler, active is 2.
  127. 18:   end;
  128. 29:   errfree;                 CLEAR 2. level error handler, active is 1.
  129. 30:  end;
  130. 47:  doerr2(4)
  131. 10:   if errset..              SET 2. level error handler. return false
  132. 16:   writeln(f,..              OK. File is open.
  133. 17:   errfree;                CLEAR 2. level error handler, active is 1.
  134. 18:  end;
  135. 48:  b:=doerr3(..
  136. 34:   doerr3:=3;
  137. 35:   errfree;               CLEAR 1. level error handler, inactive
  138. 36:   close(f);              OK. File open.
  139. 37:  end;
  140. 49:  writeln('Err3 closed..
  141. 50:  if errset..             SET 1. level error handler. return false
  142. 54:  close(f);                ERROR. File not open. go last handler.
  143. 51:   writeln('Well..
  144. 52:   continue;               JUMP back where error occured.
  145. 55:  errfree;                CLEAR 1. level error handler, inactive
  146. 56:  close(f);               ERROR. Handler inactive. Runtime error.
  147.  
  148.