fork download
copy 
  1. {$mode objfpc} {$h+}
  2. uses
  3. 	SysUtils;
  4.  
  5. type
  6. 	IAutoClosingFile = interface
  7. 		procedure Write(const s: string);
  8. 	end;
  9.  
  10. 	// Представим, что это файл, который может быть открыт только эксклюзивно —
  11. 	// не более 1 раза одновременно.
  12. 	TAutoClosingFile = class(TInterfacedObject, IAutoClosingFile)
  13. 		constructor Create;
  14. 		destructor Destroy; override;
  15. 		procedure Write(const s: string);
  16. 	private
  17. 		opened: boolean;
  18. 	class var
  19. 		GloballyOpened: boolean;
  20. 	end;
  21.  
  22. 	constructor TAutoClosingFile.Create;
  23. 	begin
  24. 		inherited Create;
  25. 		if GloballyOpened then
  26. 		begin
  27. 			writeln('Нельзя открыть файл: он уже открыт. Бросается <Исключение>.');
  28. 			raise Exception.Create('<Исключение>');
  29. 		end;
  30. 		writeln('Файл открыт.');
  31. 		GloballyOpened := true;
  32. 		opened := true;
  33. 	end;
  34.  
  35. 	destructor TAutoClosingFile.Destroy;
  36. 	begin
  37. 		if opened then
  38. 		begin
  39. 			writeln('Файл закрыт.');
  40. 			opened := false;
  41. 			GloballyOpened := false;
  42. 		end;
  43. 		inherited Destroy;
  44. 	end;
  45.  
  46. 	procedure TAutoClosingFile.Write(const s: string);
  47. 	begin
  48. 		writeln('В файл записано: "', s, '".');
  49. 	end;
  50.  
  51. 	procedure Test1_BAD;
  52. 	var
  53. 		f: IAutoClosingFile;
  54. 	begin
  55. 		writeln('Тест 1. Произойдёт ошибка: новый файл откроется прежде, чем закроется старый.');
  56. 		f := TAutoClosingFile.Create;
  57. 		f.Write('test');
  58.  
  59. 		f := TAutoClosingFile.Create;
  60. 		f.Write('test2');
  61. 	end;
  62.  
  63. 	procedure Test2_WORKAROUND;
  64. 	var
  65. 		f: IAutoClosingFile;
  66. 	begin
  67. 		writeln('Тест 2. Обход ошибки путём форсирование финализации интерфейсной переменной через := nil (можно также Finalize).');
  68. 		f := TAutoClosingFile.Create;
  69. 		f.Write('test');
  70. 		f := nil;
  71.  
  72. 		f := TAutoClosingFile.Create;
  73. 		f.Write('test2');
  74. 	end;
  75.  
  76. 	procedure Test3_WORKAROUND_2;
  77. 		procedure Write1;
  78. 		var
  79. 			f: IAutoClosingFile;
  80. 		begin
  81. 			f := TAutoClosingFile.Create;
  82. 			f.Write('test');
  83. 		end;
  84.  
  85. 		procedure Write2;
  86. 		var
  87. 			f: IAutoClosingFile;
  88. 		begin
  89. 			f := TAutoClosingFile.Create;
  90. 			f.Write('test2');
  91. 		end;
  92.  
  93. 	begin
  94. 		writeln('Тест 3. Обход ошибки разбиением на 2 процедуры.');
  95. 		Write1;
  96. 		Write2;
  97. 	end;
  98.  
  99. 	{procedure Test4_GOOD;
  100. 	begin
  101. 		writeln('Тест 4. Как это могло бы быть.');
  102. 		begin
  103. 			var f: IAutoClosingFile = TAutoClosingFile.Create;
  104. 			f.Write('test');
  105. 		end;
  106. 		begin
  107. 			var f: IAutoClosingFile = TAutoClosingFile.Create;
  108. 			f.Write('test2');
  109. 		end;
  110. 	end;}
  111.  
  112. 	procedure Run(test: TProcedure);
  113. 	begin
  114. 		try
  115. 			test();
  116. 		except
  117. 			on e: Exception do writeln(e.Message + ' обработано.');
  118. 		end;
  119. 		writeln('---');
  120. 		writeln;
  121. 	end;
  122.  
  123. begin
  124. 	Run(@Test1_BAD);
  125. 	Run(@Test2_WORKAROUND);
  126. 	Run(@Test3_WORKAROUND_2);
  127. 	writeln('Оба способа обойти ошибку были магическими или неудобными.' + LineEnding +
  128. 		'С inline-переменными можно было создать оба файла внутри отдельных скоупов begin-end, и они финализировались бы в правильные моменты.');
  129. end.
Success #stdin #stdout 0s 4484KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Тест 1. Произойдёт ошибка: новый файл откроется прежде, чем закроется старый.
Файл открыт.
В файл записано: "test".
Нельзя открыть файл: он уже открыт. Бросается <Исключение>.
Файл закрыт.
<Исключение> обработано.
---

Тест 2. Обход ошибки путём форсирование финализации интерфейсной переменной через := nil (можно также Finalize).
Файл открыт.
В файл записано: "test".
Файл закрыт.
Файл открыт.
В файл записано: "test2".
Файл закрыт.
---

Тест 3. Обход ошибки разбиением на 2 процедуры.
Файл открыт.
В файл записано: "test".
Файл закрыт.
Файл открыт.
В файл записано: "test2".
Файл закрыт.
---

Оба способа обойти ошибку были магическими или неудобными.
С inline-переменными можно было создать оба файла внутри отдельных скоупов begin-end, и они финализировались бы в правильные моменты.
https://ideone.com/GjF23I
language:
Pascal (fpc 3.0.4)
created:
3 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!