home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Pascal / BPASCAL.700 / D12 / DOCDEMO.ZIP / RECOVER.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-01  |  2.1 KB  |  107 lines
  1. {************************************************}
  2. {                                                }
  3. {   Demo program                                 }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. { RECOVER.PAS }
  9. { This program implements constructor-error recovery }
  10.  
  11. type
  12.   LinePtr = ^Line;
  13.   Line = string[79];
  14.  
  15.   BasePtr = ^Base;
  16.   Base = object
  17.     L1, L2: LinePtr;
  18.     constructor Init(S1, S2: Line);
  19.     destructor Done; virtual;
  20.     procedure Dump; virtual;
  21.   end;
  22.  
  23.   DerivedPtr = ^Derived;
  24.   Derived = object(Base)
  25.     L3, L4: LinePtr;
  26.     constructor Init(S1, S2, S3, S4: Line);
  27.     destructor Done; virtual;
  28.     procedure Dump; virtual;
  29.   end;
  30.  
  31. var
  32.   BP: BasePtr;
  33.   DP: DerivedPtr;
  34.  
  35. constructor Base.Init(S1, S2: Line);
  36. begin
  37.   New(L1);
  38.   New(L2);
  39.   if (L1 = nil) or (L2 = nil) then
  40.   begin
  41.     Base.Done;
  42.     Fail;
  43.   end;
  44.   L1^ := S1;
  45.   L2^ := S2;
  46. end;
  47.  
  48. destructor Base.Done;
  49. begin
  50.   if L2 <> nil then Dispose(L2);
  51.   if L1 <> nil then Dispose(L1);
  52. end;
  53.  
  54. procedure Base.Dump;
  55. begin
  56.   WriteLn('B: ', L1^, ', ', L2^, '.');
  57. end;
  58.  
  59. constructor Derived.Init(S1, S2, S3, S4: Line);
  60. begin
  61.   if not Base.Init(S1, S2) then Fail;
  62.   New(L3);
  63.   New(L4);
  64.   if (L3 = nil) or (L4 = nil) then
  65.   begin
  66.     Derived.Done;
  67.     Fail;
  68.   end;
  69.   L3^ := S3;
  70.   L4^ := S4;
  71. end;
  72.  
  73. destructor Derived.Done;
  74. begin
  75.   if L4 <> nil then Dispose(L4);
  76.   if L3 <> nil then Dispose(L3);
  77.   Base.Done;
  78. end;
  79.  
  80. procedure Derived.Dump;
  81. begin
  82.   WriteLn('D: ', L1^, ', ', L2^, ', ', L3^, ', ', L4^, '.');
  83. end;
  84.  
  85. {$F+}
  86. function HeapFunc(Size: Word): Integer;
  87. begin
  88.   HeapFunc := 1;
  89. end;
  90. {$F-}
  91.  
  92. begin
  93.   HeapError := @HeapFunc;               { Install heap error handler }
  94.   New(BP, Init('Borland', 'International'));
  95.   New(DP, Init('North', 'East', 'South', 'West'));
  96.   if (BP = nil) or (DP = nil) then
  97.     WriteLn('Allocation error')
  98.   else
  99.   begin
  100.     BP^.Dump;
  101.     DP^.Dump;
  102.   end;
  103.   if DP <> nil then Dispose(DP, Done);
  104.   if BP <> nil then Dispose(BP, Done);
  105. end.
  106.  
  107.