home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / vp21beta.zip / LEXMPSRC.RAR / EXCEPTS.PAS < prev    next >
Pascal/Delphi Source File  |  2000-08-15  |  4KB  |  213 lines
  1. program Excepts;
  2.  
  3. uses
  4.   SysUtils, VpSysLow, Linux;
  5.  
  6. var
  7.   I, X: LongInt;
  8.   F: Extended;
  9.   P: PChar;
  10.  
  11. begin
  12.   I := 0;
  13.   F := 0.0;
  14.   P := Pointer($12345678);
  15.  
  16.   WriteLn('First we test a complex series of language exceptions (raise):');
  17.   WriteLn('--------------------------------------------------------------');
  18.   WriteLn('Begin...');
  19.  
  20.   X := 0;
  21.  
  22.   try
  23.     WriteLn('Outer try block...');
  24.     X := X + 1;
  25.  
  26.     try
  27.       WriteLn('Middle try block...');
  28.       X := X + 1;
  29.  
  30.       try
  31.         WriteLn('Inner try block...');
  32.         X := X + 1;
  33.  
  34.         raise Exception.Create('Exception');
  35.         X := X - 1;
  36.  
  37.       except
  38.         WriteLn('Inner except block...');
  39.  
  40.         try
  41.           WriteLn('Even more inner try block...');
  42.           X := X + 1;
  43.           raise Exception.Create('Exception');
  44.           X := X - 1;
  45.         except
  46.           WriteLn('Even more inner exception handled.');
  47.           X := X + 1;
  48.         end;
  49.  
  50.         WriteLn('Re-raising exception from inner block.');
  51.  
  52.         X := X + 1;
  53.         raise;
  54.         X := X - 1;
  55.       end;
  56.  
  57.     finally
  58.       WriteLn('Middle finally block...');
  59.       X := X + 1;
  60.     end;
  61.  
  62.   except
  63.     WriteLn('Outer except block...');
  64.     X := X + 1;
  65.   end;
  66.  
  67.   WriteLn('End...');
  68.  
  69.   if X = 8 then WriteLn('Okay.') else
  70.   begin
  71.     WriteLn('Error! (X is ', X, ', should be 8.)');
  72.     Halt;
  73.   end;
  74.  
  75.   WriteLn;
  76.   WriteLn('Next we test a complex series of signal exceptions (SIGSEGV):');
  77.   WriteLn('-------------------------------------------------------------');
  78.   WriteLn('Begin...');
  79.  
  80.   X := 0;
  81.  
  82.   try
  83.     WriteLn('Outer try block...');
  84.     X := X + 1;
  85.  
  86.     try
  87.       WriteLn('Middle try block...');
  88.       X := X + 1;
  89.  
  90.         try
  91.           WriteLn('Inner try block...');
  92.           X := X + 1;
  93.  
  94.           P^ := '?';
  95.           X := X - 1;
  96.  
  97.         except
  98.           WriteLn('Inner except block...');
  99.  
  100.           try
  101.             WriteLn('Even more inner try block...');
  102.             X := X + 1;
  103.             P^ := '?';
  104.             X := X - 1;
  105.           except
  106.             WriteLn('Even more inner exception handled.');
  107.             X := X + 1;
  108.           end;
  109.  
  110.           WriteLn('Re-raising exception from inner block.');
  111.  
  112.           X := X + 1;
  113.           raise;
  114.           X := X - 1;
  115.         end;
  116.  
  117.     finally
  118.       WriteLn('Middle finally block...');
  119.       X := X + 1;
  120.     end;
  121.  
  122.   except
  123.     WriteLn('Outer except block...');
  124.     X := X + 1;
  125.   end;
  126.  
  127.   WriteLn('End...');
  128.  
  129.   if X = 8 then WriteLn('Okay.') else
  130.   begin
  131.     WriteLn('Error! (X is ', X, ', should be 8.)');
  132.     Halt;
  133.   end;
  134.  
  135.   WriteLn;
  136.   WriteLn('Finally we test some individual exceptions:');
  137.   WriteLn('-------------------------------------------');
  138.   WriteLn('Begin...');
  139.  
  140.   try
  141.     WriteLn('Trying 1 div 0...');
  142.     WriteLn(1 div I);
  143.   except
  144.     on E: Exception do
  145.     begin
  146.       WriteLn('Error: ', E.Message);
  147.     end;
  148.   end;
  149.  
  150.   WriteLn;
  151.  
  152.   try
  153.     WriteLn('Trying 1.0 / 0.0...');
  154.     WriteLn(1.0 / F);
  155.   except
  156.     on E: Exception do
  157.     begin
  158.       WriteLn('Error: ', E.Message);
  159.     end;
  160.   end;
  161.  
  162.   WriteLn;
  163.  
  164.   try
  165.     WriteLn('Trying read access at $12345678...');
  166.     WriteLn(P^);
  167.   except
  168.     on E: Exception do
  169.     begin
  170.       WriteLn('Error: ', E.Message);
  171.     end;
  172.   end;
  173.  
  174.   WriteLn;
  175.  
  176.   try
  177.     WriteLn('Trying write access at $12345678...');
  178.     P^ := '?';
  179.   except
  180.     on E: Exception do
  181.     begin
  182.       WriteLn('Error: ', E.Message);
  183.     end;
  184.   end;
  185.  
  186.   WriteLn;
  187.  
  188.   try
  189.     WriteLn('Trying signal SIGUSR2...');
  190.     LnxKill(LnxGetPid, SIGUSR2);
  191.   except
  192.     on E: Exception do
  193.     begin
  194.       WriteLn('Error: ', E.Message);
  195.     end;
  196.   end;
  197.  
  198.   try
  199.     WriteLn('Trying Ctrl-C... (please press Ctrl-C)');
  200.     ReadLn;
  201.   except
  202.     on E: Exception do
  203.     begin
  204.       WriteLn('Error: ', E.Message);
  205.     end;
  206.   end;
  207.  
  208.   WriteLn('End...');
  209.   WriteLn;
  210.   WriteLn('Everything seemed to work as designed. :-)');
  211. end.
  212.  
  213.