Ссылка. Получение ресурса есть инициализация (RAII). И "немного от себя"

https://ru.wikipedia.org/wiki/%D0%9F%D0%BE%D0%BB%D1%83%D1%87%D0%B5%D0%BD%D0%B8%D0%B5_%D1%80%D0%B5%D1%81%D1%83%D1%80%D1%81%D0%B0_%D0%B5%D1%81%D1%82%D1%8C_%D0%B8%D0%BD%D0%B8%D1%86%D0%B8%D0%B0%D0%BB%D0%B8%D0%B7%D0%B0%D1%86%D0%B8%D1%8F

Хочется написать "что-то умное", поэтому попробую добавить "немного от себя".

Приведу "надуманный пример". Но надеюсь, что он будет понят.

(Предвижу вопрос - "зачем передавать критическую секцию". Отвечу - "ни зачем". Но я и такое в реальном коде видал. В чужом)

Итак.

Пусть есть такой код:

type
 TA = class
  private
   fCS : TCriticalSection;
   procedure SomeInitCode;
   procedure SomeDoneCode;
  public
   constructor Create(aCS: TCriticalSection);
   destructor Destroy; overide;
 end;//TA
...
constructor TA.Create(aCS: TCriticalSection);
begin
 inherited Create;
 fCS := aCS;
 SomeInitCode;
 fCS.Enter;
end;

destructor TA.Destroy;
begin
 fCS.Leave;
 fCS := nil;
 SomeDoneCode;
 inherited;
end;

procedure TA.SomeInitCode;
begin
 raise Exception.Create('Some fake error');
end;

procedure TA.SomeDoneCode;
begin
 // - do nothing
end;
...
var
 A : TA;
begin
 A := TA.Create(SomeCriticalSection);
 ...
end;

Приведу ещё ссылки:

- http://www.delphimaster.net/view/14-1089121849/all
- http://www.rsdn.ru/forum/delphi/411835.flat
- http://objectmix.com/delphi/402814-exception-constructor.html

Из последней ссылки процитирую:

"No, the destructor is automatically called when an exception is raised
in the constructor."

Это написано и в документации по Delphi, но к сожалению ссылку в интернете - я не нашёл.

Поверьте мне "на слово".

Процитирую лишь место из help к Delphi XE6:

"When an exception is raised during the creation of an object, Destroy is automatically called to dispose of the unfinished object. This means that Destroy must be prepared to dispose of partially constructed objects. Because a constructor sets the fields of a new object to zero or empty values before performing other actions, class-type and pointer-type fields in a partially constructed object are always nil. A destructor should therefore check for nil values before operating on class-type or pointer-type fields. Calling the Free method (defined in TObject) rather than Destroy offers a convenient way to check for nil values before destroying an object."

- что мы тут получим?

А то, что мы попытаемся выйти из критической секции в которую не входили.

И это вообще говоря - проблема. Подробности зависят от версии Windows.

Что можно сделать?

Можно например написать так:

type
 TA = class
  private
   fCS : TCriticalSection;
   procedure SomeInitCode;
   procedure SomeDoneCode;
  public
   constructor Create(aCS: TCriticalSection);
   destructor Destroy; overide;
 end;//TA
...
constructor TA.Create(aCS: TCriticalSection);
begin
 inherited Create;
 fCS := aCS;
 fCS.Enter;
 SomeInitCode;
end;

destructor TA.Destroy;
begin
 SomeDoneCode;
 fCS.Leave;
 fCS := nil;
 inherited;
end;

procedure TA.SomeInitCode;
begin
 raise Exception.Create('Some fake error');
end;

procedure TA.SomeDoneCode;
begin
 // - do nothing
end;
...
var
 A : TA;
begin
 A := TA.Create(SomeCriticalSection);
 ...
end;

- что мы тут сделали?

Мы поменяли местами строчки:
SomeInitCode;
fCS.Enter;

- тут "всё срастётся".

Но повторю - "пример надуманный".

В реальном коде - "может и не срастись". Да и не факт, что "ресурс не захвачен" и SomeInitCode как раз и приведёт к его освобождению.

Это тоже - "звучит бредом", но так в "реальной жизни" - тоже бывает.

Тут тоже можно сказать - "присваивайте fCS непосредственно перед fCS.Enter".

Можно!

Но повторю - "пример надуманный".

Как "я считаю" было бы правильно?

А вот примерно так:
(Об "оверхеде" на время - забудем)

type
 TLocker = class
  private
   fCS : TCriticalSection;
  public
   constructor Create(aCS: TCriticalSection);
   destructor Destroy; overide;
 end;//TLocker

 TA = class
  private
   fCS : TLocker;
   procedure SomeInitCode;
   procedure SomeDoneCode;
  public
   constructor Create(aCS: TCriticalSection);
   destructor Destroy; overide;
 end;//TA
...
constructor TLocker.Create(aCS: TCriticalSection);
begin
 inherited Create;
 fCS := aCS;
 fCS.Enter;
end;

destructor TLocker.Destroy;
begin
 fCS.Leave;
 fCS := nil;
 inherited;
end;

constructor TA.Create(aCS: TCriticalSection);
begin
 inherited Create;
 SomeInitCode;
 fCS := TLocker.Create(aCS);
end;

destructor TA.Destroy;
begin
 FreeAndNil(fCS);
 SomeDoneCode;
 inherited;
end;

procedure TA.SomeInitCode;
begin
 raise Exception.Create('Some fake error');
end;

procedure TA.SomeDoneCode;
begin
 // - do nothing
end;
...
var
 A : TA;
begin
 A := TA.Create(SomeCriticalSection);
 ...
end;

- тут "всё срастается".

Всё?

Да нет - не всё.

Напишем так:

type
 TLocker = class
  private
   fCS : TCriticalSection;
  public
   constructor Create(aCS: TCriticalSection);
   destructor Destroy; overide;
 end;//TLocker

 TA = class
  private
   fCS : TLocker;
   procedure SomeInitCode;
   procedure SomeDoneCode;
  public
   constructor Create(aCS: TCriticalSection);
   destructor Destroy; overide;
 end;//TA
...
constructor TLocker.Create(aCS: TCriticalSection);
begin
 inherited Create;
 fCS := aCS;
 fCS.Enter;
end;

destructor TLocker.Destroy;
begin
 fCS.Leave;
 fCS := nil;
 inherited;
end;

constructor TA.Create(aCS: TCriticalSection);
begin
 inherited Create;
 fCS := TLocker.Create(aCS);
 SomeInitCode;
end;

destructor TA.Destroy;
begin
 SomeDoneCode;
 FreeAndNil(fCS);
 inherited;
end;

procedure TA.SomeInitCode;
begin
 // - do nothing
end;

procedure TA.SomeDoneCode;
begin
 raise Exception.Create('Some fake error');
end;
...
var
 A : TA;
begin
 A := TA.Create(SomeCriticalSection);
 ...
end;

- что мы сделали?

Мы перенесли исключение из SomeInitCode в SomeDoneCode.

И опять переставили местами: SomeInitCode; fCS := TLocker.Create(aCS);

Как было рассказано "о решении проблемы" ранее.

- в чём проблема?

А в том, что до строчки:
FreeAndNil(fCS); - мы не дойдём.

И критическую секцию - мы не освободим.

Это понятно? Или я что-то напутал?

Как можно "поправить ошибку"?

Можно написать так:

destructor TA.Destroy;
begin
 try
  SomeDoneCode;
 finally
  try
   FreeAndNil(fCS);
  finally
   inherited;
  end;
 end;
end;

- так опять - "все срастётся".

Всё? Вроде - да.

Но! "Эта ужасная лестница из try".

Что можно сделать?

Однозначного рецепта у меня - нет.

Но!

Могу предложить - "лишь беглый взгляд". Он - далеко не совершенный.

Но это путь - "куда думать" и отчасти ответ на вопрос - "почему Embarcadero так настойчиво продвигает ARC". Хотя я сам с этим и не согласен (Про ARC).

Но! Один из вариантов:

type
 ILocker = interface(IUnknown)
 end;//ILocker

 TLocker = class(TInterfacedObject, ILocker)
  private
   fCS : TCriticalSection;
  public
   constructor Create(aCS: TCriticalSection);
   destructor Destroy; overide;
 end;//TLocker

 TA = class
  private
   fCS : ILocker;
   procedure SomeInitCode;
   procedure SomeDoneCode;
  public
   constructor Create(aCS: TCriticalSection);
   destructor Destroy; overide;
 end;//TA
...
constructor TLocker.Create(aCS: TCriticalSection);
begin
 inherited Create;
 fCS := aCS;
 fCS.Enter;
end;

destructor TLocker.Destroy;
begin
 fCS.Leave;
 fCS := nil;
 inherited;
end;

constructor TA.Create(aCS: TCriticalSection);
begin
 inherited Create;
 fCS := TLocker.Create(aCS);
 SomeInitCode;
end;

destructor TA.Destroy;
begin
 SomeDoneCode;
 fCS := nil;
 inherited;
end;

procedure TA.SomeInitCode;
begin
 // - do nothing
end;

procedure TA.SomeDoneCode;
begin
 raise Exception.Create('Some fake error');
end;
...
var
 A : TA;
begin
 A := TA.Create(SomeCriticalSection);
 ...
end;

Что мы получили?

Мы получили тот факт, что fCS - будет однозначно освобождён.
И как следствие - мы попадём в fCS.Leave;

Зачем написана вот эта строчка:
fCS := nil;
?

Ну скажем так - "чтобы гарантировать порядок выполнения" хотя бы в случае отсутствия исключений.

Криво? Да - "местами криво".

Но - "лучше, чем ничего".

Какое решение является серебряной пулей?

Я пока - не знаю.

Есть один вариант.

Он описан тут - Черновик. Написать о том как использование "шаблонов" и "примесей" избавляет от "косвенности" и лишнего распределения памяти

На что стоит обратить внимание?

А вот на это:

constructor Tm3CustomHeaderStream.Create(const AStream: IStream;
                                         const AAccess: LongInt);
begin
 inherited;
 m2InitOperation(_Status,InitProc00000001($00000001));
 m2InitOperation(_Status,InitProc00000002($00000002));
 m2InitOperation(_Status,InitProc00000004($00000004));
 m2InitOperation(_Status,InitProc00000008($00000008));
 m2InitOperation(_Status,InitProc00000010($00000010));
end;
 
procedure Tm3CustomHeaderStream.Cleanup;
begin
 m2DoneOperation(_Status,$00000010,DoneProc00000010);
 m2DoneOperation(_Status,$00000008,DoneProc00000008);
 m2DoneOperation(_Status,$00000004,DoneProc00000004);
 m2DoneOperation(_Status,$00000002,DoneProc00000002);
 m2DoneOperation(_Status,$00000001,DoneProc00000001);
 inherited;
end;
...
procedure m2InitOperation(var   AStatus: LongWord;
                          const ABitMask: LongWord);
begin
 Assert((AStatus and ABitMask) = 0);
 AStatus:=AStatus or ABitMask;
end;

procedure m2DoneOperation(var   AStatus: LongWord;
                          const ABitMask: LongWord;
                          const AClassDoneProc: Tm2ClassDoneProc);
begin
 if ((AStatus and ABitMask) <> 0) then
 begin
  try
   AClassDoneProc();
  except
   m2ExcErrHandler();
  end;
  AStatus:=AStatus and not(ABitMask);
 end;
end;

Что тут написано?

А вот что:

В конструкторе вызываются процедуры вида InitProcXXX и они взводят в "маске состояния" биты означающие, что "этот метод был вызван".
А в деструкторе вызываются процедуры вида DoneProcXXX. И сбрасывают биты в "маске состояний".

Причём про DoneProcXXX есть два момента:

1. Они вызываются только если взведён соответствующий бит.
2. Они обрамлены блоком try..except. Т.е. они позволяют пройти следующим процедурам DoneProcXXX даже если в предыдущих произошло исключение.

Что сказать?

Этот вариант - железобетонный. И в нём - проблем нет.

И - не я его придумал. А другие умные люди.

Он реально - железобетонный.

Но!

Чем он мне не нравится?

А тем, что он не читабельный. Вообще.

Не знаю кому как, но от него мне лично - крышу рвёт. Но он - работает.

Когда подобный код "генерируется из UML" (Зачем UML) то это "куда ни шло.

А если это "руками писать" и потом читать - это - беда. Но зато - работает.

В общем - подведу итоги. Проблему я обозначил - "возбуждение исключений в конструкторах и деструкторах" и как следствие - неполная инициализация и деинициализация объектов. И как следствие - негарантированное получение/освобождение ресурсов.

Свои пути решения - я также перечислил. Они - не идеальны. Но! "Лучше чем ничего".

Если у кого-то есть лучшие варианты - я бы с удовольствием их бы посмотрел.

Спасибо за внимание. Надеюсь, что "что-то умное" написать таки - удалось.

P.S. Кстати есть "ещё два слова" - AfterConstruction и BeforeDestruction.

Процитирую документацию к Delphi:

"Responds after the last constructor has executed.
AfterConstruction is called automatically after the object's last constructor has executed. Do not call it explicitly in your applications.
The AfterConstruction method implemented in TObject does nothing. Override this method when creating a class that performs an action after the object is created. For example, TCustomForm overrides AfterConstruction to generate an OnCreate event."

"Responds before the first destructor executes.
BeforeDestruction is called automatically before the object's first destructor executes. Do not call it explicitly in your applications.
The BeforeDestruction method implemented in TObject does nothing. Override this method when creating a class that performs an action before the object is destroyed. For example, TCustomForm overrides BeforeDestruction to generate an OnDestroy event.

Note: BeforeDestruction is not called when the object is destroyed before it is fully constructed. That is, if the object's constructor raises an exception, the destructor is called to dispose of the object, but BeforeDestruction is not called. "

Внимание стоит обратить вот на что:

"Note: BeforeDestruction is not called when the object is destroyed before it is fully constructed. That is, if the object's constructor raises an exception, the destructor is called to dispose of the object, but BeforeDestruction is not called."

sic!

P.P.S. И вот ещё связанная вещь - BeforeRelease.

Ну и вот ещё ссылки:

http://18delphi.blogspot.ru/2013/04/3.html
http://18delphi.blogspot.ru/2013/04/iunknown.html

P.P.P.S. Есть ещё одна вещь - AutoPtr - они "сходны подсчёту ссылок", но имеют "особенное применение". Свои мысли об "умных указателях" для Delphi я попробую как-нибудь потом рассказать.

MindStream. Как мы пишем ПО под FireMonkey. Часть 2

Часть 1.
Продолжаем разрабатывать "рисовалку" под FireMonkey.

Черновик. Написать о том как использование "шаблонов" и "примесей" избавляет от "косвенности" и лишнего распределения памяти

Написать о том как использование "шаблонов" и "примесей" избавляет от "косвенности" и лишнего распределения памяти.

На примере Tm3HeaderStream.

Можно ведь так:

type
 TA = class
  private
   fData : Pointer;
  private
   procedure AllocData;
  protected
   function DataSize: Integer; virtual; abstract;
 end;//TA

...

 TC = record
  ...
 end;//TC

 TB = class(TA)
  protected
   function DataSize: Integer; override;
 end;//TB

...

procedure TA.AllocData;
begin
 GetMem(fData, DataSize);
end;
...

function TB.DataSize: Integer; override;
begin
 Result := SizeOf(TC);
end;

А можно так:

type
 TA<T> = class
  private
   fData : T;
 end;/TA

...

 TC = record
  ...
 end;/TC

 TB = class(TA<TC>)
 end;//TB

Мне кажется, что второй вариант - "вкуснее".

Смежные темы:

- Абстрактные контейнеры
- Абстрактные контейнеры. Часть 2
- Пояснение про контейнеры
- Выводим конкретные атомарные контейнеры из абстрактных
- Конкретные контейнеры. Часть 2
- Стандартная библиотека шаблонов
- Коротко. САМОЕ удивительное знание, которое я вынес из книг о программировании
- ToDo. Написать про массивы, списки и итераторы
- Про скрипты, итераторы и обработку исключений. Черновик

Старый код Tm3HeaderStream:

type
        Tm3CustomHeaderStream=    class(Tm3CustomStream)
         {* Поток с заголовком-идентификатором. }
         private


          _Status:                LongWord;


                function          InitProc00000001    (const ABitMask: LongWord
                                                      ): LongWord;

                procedure         DoneProc00000001    (
                                                      );


                function          InitProc00000002    (const ABitMask: LongWord
                                                      ): LongWord;

                procedure         DoneProc00000002    (
                                                      );


                function          InitProc00000004    (const ABitMask: LongWord
                                                      ): LongWord;

                procedure         DoneProc00000004    (
                                                      );


                function          InitProc00000008    (const ABitMask: LongWord
                                                      ): LongWord;

                procedure         DoneProc00000008    (
                                                      );


                function          InitProc00000010    (const ABitMask: LongWord
                                                      ): LongWord;

                procedure         DoneProc00000010    (
                                                      );


         protected


                procedure         CreateContext       (
                                                      ); override;


         private
          FHeaderData:            Pointer;
          FHeaderDataCompare:     Pointer;
          FHeaderDataSize:        LongInt;

          FHeaderFullSize:        LongInt;

          FHeaderSize:            LongInt;

          FHeaderLoaded:          LongInt;
          FHeaderLocked:          LongInt;


         protected
           procedure Cleanup;
                  override;
                  {-}


                property          _HeaderData: Pointer read FHeaderData;


                function          InitHeaderData      (
                                                      ): Pointer; virtual; abstract;

                function          InitHeaderDataSize  (
                                                      ): LongInt; virtual; abstract;

                function          InitHeaderFullSize  (
                                                      ): LongInt; virtual; abstract;


                procedure         DefaultInitAction   (
                                                      ); virtual;

                procedure         DefaultDoneAction   (
                                                      ); virtual;


                procedure         Read                (ABuff: Pointer;
                                                       ASize: LongInt;
                                                       var   AResult: LongInt;
                                                       var   AReturn: HRESULT
                                                      ); override;

                procedure         Write               (ABuff: Pointer;
                                                       ASize: LongInt;
                                                       var   AResult: LongInt;
                                                       var   AReturn: HRESULT
                                                      ); override;


                procedure         Seek                (AOffset       : Int64;
                                                       AOrigin       : TSeekOrigin;
                                                       var   AResult : Int64;
                                                       var   AReturn : HRESULT
                                                      ); override;


                procedure         SetSize             (ASize: Int64;
                                                       var   AReturn: HRESULT
                                                      ); override;


                procedure         LockRegion          (AOffset: Int64;
                                                       ASize: Int64;
                                                       ALockType: LongInt;
                                                       var   AReturn: HRESULT
                                                      ); override;

                procedure         UnlockRegion        (AOffset: Int64;
                                                       ASize: Int64;
                                                       ALockType: LongInt;
                                                       var   AReturn: HRESULT
                                                      ); override;


          function pm_GetSize: Int64;
            override;
            {-}

      function pm_GetLocksSupported: Longint;
        override;
        {-}
      procedure StatStgName(var   AResult : PWideChar;
                            var   AReturn : HRESULT);
        override;
        {-}

         public


          class function          HeaderID            (
                                                      ): TCLSID; virtual; abstract;


                constructor       Create              (const AStream: IStream;
                                                       const AAccess: LongInt
                                                      );
                  {* - создает поток c заголовком вокруг потока aStream. }                                    

                procedure         LoadHeader          (
                                                      );
                  {* - загружает заголовок в память. }                                    

                procedure         SaveHeader          (const AForcedSave: LongBool = False
                                                      );
                  {* - сохраняет заголовок. }


                procedure         LockHeader          (
                                                      );
                  {* - закрывает заголовок. }                                    

                procedure         UnlockHeader        (
                                                      );
                  {* - открывает заголовок. }                                    


         end;//Tm3CustomHeaderStream
...
// start class Tm3CustomHeaderStream

function Tm3CustomHeaderStream.InitProc00000001(const ABitMask: LongWord): LongWord;
begin
 {$IfDef m3UseL3Memory}
 m3HeaderBuffers^.AllocItem(FHeaderData, FHeaderFullSize, InitHeaderData, FHeaderDataSize);
 {$Else  m3UseL3Memory}
 m2MEMAllocBuff(FHeaderData,FHeaderFullSize,InitHeaderData,FHeaderDataSize);
 {$EndIf m3UseL3Memory}
 Result:=ABitMask;
end;

procedure Tm3CustomHeaderStream.DoneProc00000001;
begin
 {$IfDef m3UseL3Memory}
 m3HeaderBuffers^.FreeItem(FHeaderData);
 {$Else  m3UseL3Memory}
 m2MEMFree(FHeaderData);
 {$EndIf m3UseL3Memory}
end;

function Tm3CustomHeaderStream.InitProc00000002(const ABitMask: LongWord): LongWord;
begin
 if not ReadOnly then
 {$IfDef m3UseL3Memory}
  m3HeaderBuffers^.AllocItem(FHeaderDataCompare, FHeaderFullSize, InitHeaderData, FHeaderDataSize);
 {$Else  m3UseL3Memory}
  m2MEMAllocBuff(FHeaderDataCompare,FHeaderFullSize,InitHeaderData,FHeaderDataSize);
 {$EndIf m3UseL3Memory}
 Result:=ABitMask;
end;

procedure Tm3CustomHeaderStream.DoneProc00000002;
begin
 {$IfDef m3UseL3Memory}
 m3HeaderBuffers^.FreeItem(FHeaderDataCompare);
 {$Else  m3UseL3Memory}
 m2MEMFree(FHeaderDataCompare);
 {$EndIf m3UseL3Memory}
end;

function Tm3CustomHeaderStream.InitProc00000004(const ABitMask: LongWord): LongWord;
begin
 {$IFDEF _m3AUTOCREATEHEADER1}
 if (_Stream <> nil) then begin
  LockHeader;
  try
   if (m2COMGetSize(_Stream) = 0) then begin
    Assert(m2COMCheckAccess(m2COMModeAccess(m2COMGetStatStgMode(_Stream)),STGM_WRITE));
    FHeaderLoaded:=1;
    SaveHeader(True);
   end;//m2COMGetSize(_Stream) = 0
  finally
   UnlockHeader;
  end;
 end;//_Stream <> nil
 {$ENDIF}
 Result:=ABitMask;
end;

procedure Tm3CustomHeaderStream.DoneProc00000004;
begin
end;

function Tm3CustomHeaderStream.InitProc00000008(const ABitMask: LongWord): LongWord;
begin
 DefaultInitAction;
 Result:=ABitMask;
end;

procedure Tm3CustomHeaderStream.DoneProc00000008(
                                                  );
begin
 DefaultDoneAction;
end;

function Tm3CustomHeaderStream.InitProc00000010(const ABitMask: LongWord): LongWord;
begin
 if (_Stream <> nil) AND (m2COMGetStatStgMode(_Stream) AND STGM_WRITE = 0) then
  m2COMSetPosition(Int64(FHeaderSize),_Stream);
 Result:=ABitMask;
end;

procedure Tm3CustomHeaderStream.DoneProc00000010;
begin
end;

procedure Tm3CustomHeaderStream.CreateContext;
begin
 inherited;
 FHeaderDataSize:=InitHeaderDataSize;
 FHeaderFullSize:=InitHeaderFullSize;
 FHeaderSize:=CAnyGUIDLength+SizeOf(LongInt)+SizeOf(FHeaderFullSize)+FHeaderFullSize;
end;

procedure Tm3CustomHeaderStream.DefaultInitAction;
begin
 LoadHeader;
end;

procedure   Tm3CustomHeaderStream.DefaultDoneAction;
begin
 SaveHeader;
end;

procedure   Tm3CustomHeaderStream.Read(ABuff: Pointer;
                                       ASize: LongInt;
                                       var   AResult: LongInt;
                                       var   AReturn: HRESULT
                                      );
begin
 if SUCCEEDED(AReturn) then
  AReturn:=_Stream.Read(ABuff,ASize,@AResult);
end;

procedure   Tm3CustomHeaderStream.Write(ABuff: Pointer;
                                        ASize: LongInt;
                                        var   AResult: LongInt;
                                        var   AReturn: HRESULT
                                       );
begin
 if SUCCEEDED(AReturn) then
  AReturn:=_Stream.Write(ABuff,ASize,@AResult);
end;

procedure Tm3CustomHeaderStream.Seek(AOffset     : Int64;
                                     AOrigin     : TSeekOrigin;
                                     var AResult : Int64;
                                     var AReturn : HRESULT);
var
 LOffset : Int64;
begin
 if SUCCEEDED(AReturn) then
 begin
  if (AOrigin = soBeginning) then
   LOffset:=AOffset+Int64(FHeaderSize)
  else
  if (AOrigin = soEnd) then
  begin
   Assert(false, 'Если это всплывёт, то можно этот Assert временно закомментирровать');
   LOffset := AOffset;
  end//AOrigin = soEnd
  else
   LOffset := AOffset;
  AResult:=m2COMSeek(_Stream,LOffset,Ord(AOrigin))-Int64(FHeaderSize);
 end;//SUCCEEDED(AReturn)
end;

procedure Tm3CustomHeaderStream.SetSize(ASize: Int64;
                                        var   AReturn: HRESULT);
begin
 if SUCCEEDED(AReturn) then
  AReturn:=_Stream.SetSize(ASize+Int64(FHeaderSize));
end;

procedure Tm3CustomHeaderStream.LockRegion(AOffset: Int64;
                                           ASize: Int64;
                                           ALockType: LongInt;
                                           var   AReturn: HRESULT);
begin
 if SUCCEEDED(AReturn) then
  AReturn:=_Stream.LockRegion(Int64(FHeaderSize)+AOffset,ASize,ALockType);
end;

procedure Tm3CustomHeaderStream.UnlockRegion(AOffset: Int64;
                                             ASize: Int64;
                                             ALockType: LongInt;
                                             var   AReturn: HRESULT);
begin
 if SUCCEEDED(AReturn) then
  AReturn:=_Stream.UnlockRegion(Int64(FHeaderSize)+AOffset,ASize,ALockType);
end;

function Tm3CustomHeaderStream.pm_GetSize: Int64;
  //override;
  {-}
begin
 Result:=m2COMGetStatStgSize(_Stream)-Int64(FHeaderSize);
end;

function Tm3CustomHeaderStream.pm_GetLocksSupported: Longint;
  //override;
  {-}
begin
 Result:=m2COMGetStatStgLocks(_Stream);
end;

procedure Tm3CustomHeaderStream.StatStgName(var   AResult : PWideChar;
                                            var   AReturn : HRESULT);
  //override;
  {-}
begin
 if SUCCEEDED(AReturn) then
  try
   aResult := m2COMGetStatStgName(_Stream);
  except
   on E: EOleSysError do aReturn := E.ErrorCode;
  end;//try..except
end;

constructor Tm3CustomHeaderStream.Create(const AStream: IStream;
                                         const AAccess: LongInt);
begin
 inherited;
 m2InitOperation(_Status,InitProc00000001($00000001));
 m2InitOperation(_Status,InitProc00000002($00000002));
 m2InitOperation(_Status,InitProc00000004($00000004));
 m2InitOperation(_Status,InitProc00000008($00000008));
 m2InitOperation(_Status,InitProc00000010($00000010));
end;

procedure Tm3CustomHeaderStream.Cleanup;
begin
 m2DoneOperation(_Status,$00000010,DoneProc00000010);
 m2DoneOperation(_Status,$00000008,DoneProc00000008);
 m2DoneOperation(_Status,$00000004,DoneProc00000004);
 m2DoneOperation(_Status,$00000002,DoneProc00000002);
 m2DoneOperation(_Status,$00000001,DoneProc00000001);
 inherited;
 FHeaderData := nil;//            Pointer;
 FHeaderDataCompare := nil;//     Pointer;
 FHeaderDataSize := 0;//        LongInt;

 FHeaderFullSize := 0;//        LongInt;

 FHeaderSize := 0;//            LongInt;

 FHeaderLoaded := 0;//          LongInt;
 FHeaderLocked := 0;//         LongInt;
 _Status := 0;
end;

procedure Tm3CustomHeaderStream.LoadHeader(
                                            );
var
 LBodyCRC        : LongInt;
 LHeaderID       : AnsiString;
 LHeaderFullSize : LongInt;
 LPosition       : Int64;
begin
 if (FHeaderLoaded = 0) then
 begin
  if (_Stream <> nil) AND (m2COMGetStatStgMode(_Stream) AND STGM_WRITE = 0) then
  begin
   // - мы не можем считать Header - значит он уже должен быть у нас
   LPosition:=m2COMGetPosition(_Stream);
   try
    m2COMSetPosition(0,_Stream);

    m2COMCLSIDFromStream(_Stream,LHeaderID);
    m2COMReadBuffer(_Stream,LBodyCRC,SizeOf(LBodyCRC));

    m2COMReadBuffer(_Stream,LHeaderFullSize,SizeOf(LHeaderFullSize));
    m2CheckValue((LHeaderID = GUIDToString(HeaderID)) and
                 (LHeaderFullSize = FHeaderFullSize));

    m2COMReadBuffer(_Stream,FHeaderData^,FHeaderFullSize);
   finally
    m2COMSetPosition(LPosition,_Stream);
   end;//try..finally
   m2MEMCopy(FHeaderDataCompare,FHeaderData,FHeaderDataSize);
  end;//_Stream <> nil..
 end;//FHeaderLoaded = 0
 Inc(FHeaderLoaded);
end;

procedure Tm3CustomHeaderStream.SaveHeader(const AForcedSave: LongBool);
var
 LBodyCRC  : LongInt;
 LPosition : Int64;
 l_Fake    : Int64;
begin
 Dec(FHeaderLoaded);
 if (FHeaderLoaded = 0) AND (_Stream <> nil) AND not ReadOnly then
 begin
  if AForcedSave or
     (m2MEMCompare(FHeaderData,FHeaderDataCompare,FHeaderDataSize) <> 0) then
  begin
     m2MEMCopy(FHeaderDataCompare,FHeaderData,FHeaderDataSize);
   LPosition:=m2COMGetPosition(_Stream);
   try
    LBodyCRC := 0;
    if AForcedSave then
    begin
     if l3IFail(_Stream.Seek(0, STREAM_SEEK_SET, l_Fake)) then
      Exit;
     m2COMCLSIDToStream(_Stream,GUIDToString(HeaderID));
    end//AForcedSave
    else
    if l3IFail(_Stream.Seek(CAnyGUIDLength, STREAM_SEEK_SET, l_Fake)) then
     Exit;
    m2COMWriteBuffer(_Stream,LBodyCRC,SizeOf(LBodyCRC));
    m2COMWriteBuffer(_Stream,FHeaderFullSize,SizeOf(FHeaderFullSize));
    m2COMWriteBuffer(_Stream,FHeaderData^,FHeaderFullSize);
   finally
    _Stream.Seek(lPosition, STREAM_SEEK_SET, l_Fake);
   end;//try..finally
  end;//AForcedSave..
 end;//FHeaderLoaded = 0..
end;

procedure Tm3CustomHeaderStream.LockHeader;
begin
 if ((FHeaderLocked = 0) and m2COMIsLocksSupported(_Stream)) then
  m2COMTimeLock(_Stream,CAnyGUIDLength,Int64(FHeaderSize)-CAnyGUIDLength);
 Inc(FHeaderLocked);
end;

procedure Tm3CustomHeaderStream.UnlockHeader;
begin
 Dec(FHeaderLocked);
 if ((FHeaderLocked = 0) and m2COMIsLocksSupported(_Stream)) then
  m2COMTimeUnlock(_Stream,CAnyGUIDLength,Int64(FHeaderSize)-CAnyGUIDLength);
end;
...

Новый код, я вскоре выложу.

Он НА ПОРЯДОК - короче и читабельнее.

Вот уж как "быдло-код" становится "просто кодом" (
- http://programmingmindstream.blogspot.ru/2014/08/blog-post_59.html
- http://programmingmindstream.blogspot.ru/2014/08/mindstream-firemonkey.html?showComment=1407782559954#c112802013383687686
- http://programmingmindstream.blogspot.ru/2014/08/di-service-locator.html
).

Анонс от Embarcadero. Скоро выходит Delphi XE7

Вот информация от Embarcadero:

--- Начало цитаты ---

Предварительный обзор RAD Studio XE7

Приглашаем вас принять участие в мероприятиях для разработчиков, посвящённых обзору возможностей RAD Studio XE7, которые пройдут 16 сентября в Москве, 18 сентября в Астане и 23 сентября Екатеринбурге.

RAD Studio XE7 позволяет быстро создавать приложения, обладающие всем необходимым функционалом по взаимодействию с практически любыми устройствами, корпоративными источниками данных и популярными облачным сервисами.

Вы узнаете, как с помощью новых возможностей RAD Studio XE7:

• разрабатывать кроссплатформенные приложения с новым конструктором единого интерфейса;
• улучшать производительность настольных и мобильных приложений с помощью библиотеки параллельных вычислений, используя преимущества многоядерных процессоров;
• cбалансировать ИТ инфраструктуру за счет включения мобильных сервисов

На конференции в Москве специальная сессия Samsung будет посвящена тому, что нужно знать разработчику, чтобы не просто создавать приложения, но эффективно «вписывать» их в сложившуюся IT-инфраструктуру.

Подробности и регистрация на сайте http://delphitour.ru/

--- Конец цитаты ---

"От себя" - добавлю:

- "новым конструктором единого интерфейса" - очень интересно - что это значит? Или всего лишь "маркетинговый ход"?

- "улучшать производительность настольных и мобильных приложений с помощью библиотеки параллельных вычислений, используя преимущества многоядерных процессоров" - это как? Есть поддержка языка? Компилятора? Или всё тот же TThread? Или есть TThreadPool? Или TAsyncOperation? (я ля NSOperation)

- "cбалансировать ИТ инфраструктуру за счет включения мобильных сервисов" - это как? Что имеется в виду? Возможность "мобильной разработки"?Так это и так было. Или что-то иное?

- "но эффективно «вписывать» их в сложившуюся IT-инфраструктуру" - ну и это конечно - интересно послушать. Детали. Технические. Для "ремесленников", а не "маркетологическое бла бла бла" типа "усилим и убыстрим". Простите за резкость.

Я лично - планирую сходить. На "мероприятие в Москве", потому, что "у меня есть вопросы". Надеюсь, что я их смогу задать.

P.S. Вот Всеволод Леонов умел сочетать "маркетологическое бла бла бла" с "интересами ремесленников". Посмотрим как "новые люди" с этим справятся.

У Всеволода всё было "живо и заводно" и "местами по делу", а вот когда я посещал пару семинаров ещё Borland'а - ну "хотелось спать и зевать"...

Посмотрим.

Offtopic. Ну и ещё. В свете последних событий

http://www.mnemosyne.ru/homo/galich-5.html

А. Галич

Песня пятая, которая поется и называется
Ave Maria!

(прослушать звукозапись пятой песни в исполнении автора, в формате mp3, 1,43Mb)

Дело явно липовое - все как на ладони,
Но пятую неделю долбят допрос,
Следователь-хмурик с утра на валидоле,
Как Пророк, подследственный бородой оброс...

А Мадонна шла по Иудее.
В платьице, застиранном до сини,
Шла Она с котомкой за плечами,
С каждым шагом становясь красивей,
С каждым вздохом делаясь печальней.
Шла, платок на голову набросив, -
Всех земных страданий средоточьем,
И уныло брел за ней Иосиф,
Убежавший славы Божий отчим...
Ave Maria...

Упекли Пророка в респулику Коми,
А он и перекинься башкою в лебеду...
А следователь-хмурик получил в месткоме
Льготную путевку на месяц в Теберду...

А Мадонна шла по Иудее,
Оскользаясь на размокшей глине,
Обдирая платье о терновник,
Шла она и думала о Сыне
И о смертных горестях сыновних.
Ах, как ныли ноги у Мадонны,
Как хотелось всхлипнуть по-ребячьи,
А в ответ Ей ражие долдоны
Отпускали шутки жеребячьи...
Ave Maria...

Грянули впоследствии всякие хренации,
Следователь-хмурик на пенсии в Москве,
А справочку с печатью о реабилитации
Выслали в Калинин Пророковой вдове...

А Мадонна шла по Иудее...
И все легче, тоньше, все худее
С каждым шагом становилось тело...
А вокруг шумела Иудея
И о мертвых помнить не хотела.
Но ложились тени на суглинок,
И роились тени в каждой пяди,
Тени всех бутырок и треблинок,
Всех измен, предательств и распятий...
Ave Maria...

И послесловие, написанное во хмелю, которое иногда говорится, иногда поется

(прослушать звукозапись послесловия в исполнении автора, в формате mp3, 1,58Mb)

То-то радости пустомелям,
Темноты своей не стыжусь,
Не могу я быть Птоломеем,
Даже в Энгельсы не гожусь.
Но от вечного бегства в мыле,
Неустройством земным томим,
Вижу - что-то неладно в мире,
Хорошо бы заняться им,
Только век меня держит цепко,
С ходу гасит любой порыв,
И от горести нет рецепта,
Все, что были, - сданы в архив.
И все-таки я, рискуя прослыть
Шутом, дураком, паяцем,
И ночью, и днем твержу об одном -
Не надо, люди, бояться!
Не бойтесь тюрьмы, не бойтесь сумы,
Не бойтесь мора и глада,
А бойтесь единственно только того,
Кто скажет: "Я знаю, как надо!"
Кто скажет: "Идите, люди, за мной,
Я вас научу, как надо!"

И, рассыпавшись мелким бесом,
И поклявшись вам всем в любви,
Он пройдет по земле железом
И затопит ее в крови.
И наврет он такие враки,
И такой наплетет рассказ,
Что не раз тот рассказ в бараке
Вы помянете в горький час.
Слезы крови не солонее,
Дорогой товар, даровой!
Прет история - Саломея
С Иоанновой головой.

Земля - зола и вода - смола,
И некуда, вроде, податься,
Неисповедимы дороги зла,
Но не надо, люди, бояться!
Не бойтесь золы, не бойтесь хулы,
Не бойтесь пекла и ада,
А бойтесь единственно только того,
Кто скажет: "Я знаю, как надо!"
Кто скажет: "Всем, кто пойдет за мной,
Рай на земле - награда".

Потолкавшись в отделе винном,
Подойду к друзьям-алкашам,
При участии половинном
Побеседуем по душам,
Алкаши наблюдают строго,
Чтоб ни капли не пролилось.
"Не встречали - смеются - Бога?"
"Ей же Богу, не привелось".
Пусть пивнуха не лучший случай
Толковать о добре и зле,
Но видали мы этот "лучший"
В белых тапочках, на столе.

Кому "сучок", а кому коньячок,
К начальству - на кой паяться?!
А я все твержу им, ну, как дурачок:
Не надо, братцы, бояться!
И это бред, что проезда нет,
И нельзя входить без доклада,
А бояться-то надо только того,
Кто скажет: "Я знаю, как надо!"
Гоните его! Не верьте ему!
Он врет! Он не знает - как надо!

Offtopic. И ещё

http://www.bards.ru/archives/part.php?id=4114

" Александр Галич

                "... правление Литературного Фонда СССР извещает
                о смерти писателя, члена Литфонда, Бориса
                Леонидовича Пастернака, последовавшей
                30 мая сего года, на 71-ом году жизни, после
                тяжелой и продолжительной болезни, и выражает
                соболезнование семье покойного".
                        (Единственное, появившееся в газетах, вернее,
                        в одной - "Литературной газете", - сообщение
                        о смерти Б.Л.Пастернака)

Разобрали венки на веники, 
На полчасика погрустнели... 
Как гордимся мы, современники, 
Что он умер в своей постели! 
И терзали Шопена лабухи, 
И торжественно шло прощанье... 
Он не мылил петли в Елабуге 
И с ума не сходил в Сучане! 
Даже киевские письмэнники 
На поминки его поспели. 
Как гордимся мы, современники, 
Что он умер в своей постели!.. 

И не то чтобы с чем-то за сорок — 
Ровно семьдесят, возраст смертный. 
И не просто какой-то пасынок — 
Член Литфонда, усопший сметный! 
Ах, осыпались лапы елочьи, 
Отзвенели его метели... 
До чего ж мы гордимся, сволочи, 
Что он умер в своей постели! 

"Мело, мело по всей земле 
Во все пределы. 
Свеча горела на столе, 
Свеча горела..." 

Нет, никакая не свеча — 
Горела люстра! 
Очки на морде палача 
Сверкали шустро! 

А зал зевал, а зал скучал — 
Мели, Емеля! 
Ведь не в тюрьму и не в Сучан, 
Не к высшей мере! 

И не к терновому венцу 
Колесованьем, 
А как поленом по лицу — 
Голосованьем! 

И кто-то, спьяну, вопрошал: 
— За что? Кого там? 
И кто-то жрал, и кто-то ржал 
Над анекдотом... 

Мы не забудем этот смех 
И эту скуку! 
Мы — поименно! — вспомним всех, 
Кто поднял руку!.. 

"Гул затих. Я вышел на подмостки. 
Прислонясь к дверному косяку..." 

Вот и смолкли клевета и споры, 
Словно взят у вечности отгул... 
А над гробом встали мародёры 
И несут почётный ка-ра-ул! 

Переделкино,
4 декабря 1966

"

Намекаю на "Андрея Вадимовича".. Но лишь.. намекаю..

http://www.kp.ru/daily/26273.5/3151153/

Хотя кто знает...

http://programmingmindstream.blogspot.ru/2014/08/offtopic_92.html

Offtopic. Ещё

"На сопках Манчжурии(Памяти М.М.Зощенко)"

http://textbase.ru/song/song/764929

"В матершинном субботнем загуле шалманчика
Обезьянка спала на плече у шарманщика,
А когда просыпалась, глаза ее жуткие
Выражали почти человечью отчаянность,
А шарманка дудела про сопки манчжурские,
А Тамарка-буфетчица очень печалилась...
( )
Спит Гаолян,
Сопки покрыты мглой...

Были и у Томки трали-вали,
И не Томкой - Томочкою звали,
Целовались с миленьким в осоке,
И не пивом пахло, а апрелем,
Может быть, и впрямь на той высотке
Сгинул он, порубан и пострелян...
Вот из-за туч блеснула луна,
Могилы хранят покой...

А последний шарманщик - обломок империи,
Все пылил перед Томкой павлиньими перьями,
Он выламывал, шкура, замашки буржуйские -
То, мол, теплое пиво, то мясо прохладное,
А шарманка дудела про сопки манчжурские,
И спала на плече обезьянка прокатная...
Тихо вокруг,
Ветер туман унес...

И делясь тоской,как барышами,
Подпевали шлюхи с алкашами,
А шарманщик ел, зараза, хаши,
Алкашам подмигивал прелестно -
Дескать, деньги ваши - будут наши,
Дескать, вам приятно - мне полезно!
На сопках Манчжурии воины спят,
И русских не слышно слез...

А часов этак в десять, а может, и ранее,
Непонятный чудак появился в шалмании,
Был похож он на вдруг постаревшего мальчика.
За рассказ, напечатанный неким журнальчиком,
Толстомордый подонок с глазами обманщика
Объявил чудака всенародно обманщиком...
Пусть Гаолян
Нам навевает сны...

Сел чудак за стол и вжался в угол,
И легонько пальцами постукал,
И сказал, что отдохнет немного,
Помолчав, добавил напряженно, -
"Если есть "Боржом", то ради Бога,
Дайте мне бутылочку "Боржома"..."
Спите, герои русской земли,
Отчизны родной сыны...

Обезьянка проснулась, тихонько зацокала,
Загляделась на гостя, присевшего около,
А Тамарка-буфетчица - сука рублевая,
Покачала смущенно прическою пегою,
И сказала :"Пардон, но у нас не столовая,
Только вы обождите, я за угол сбегаю..."
Спит Гаолян,
Сопки покрыты мглой...

А чудак глядел на обезьянку,
Пальцами выстукивал морзянку,
Словно бы он звал ее на помощь,
Удивляясь своему бездомью,
Словно бы он спрашивал - запомнишь? -
И она кивала - да, запомню, -
Вот из-за туч блеснула луна,
Могилы хранят покой...

Отодвинул шарманщик шарманку ботинкою,
Прибежала Тамарка с боржомной бутылкой -
И сама налила чудаку полстаканчика,
(Не знавали в шалмане подобные почести),
А Тамарка,в упор поглядев на шарманщика,
Приказала :"Играй, - человек в одиночестве". -
Тихо вокруг,
Ветер туман унес...

Замолчали шлюхи с алкашами,
Только мухи крыльями шуршали...
Стало почему-то очень тихо,
Наступила странная минута -
Непонятное, чужое лихо -
Стало общим лихом почему-то!
На сопках Манчжурии воины спят,
И русских не слышно слез...

Не взрывалось молчаньем, ни матом, ни брехами,
Обезьянка сипела спаленными бронхами,
И шарманщик, забыв трепотню свою барскую,
Сам назначил себе - мол, играй, да помалкивай,-
И почти что неслышно сказав,- благодарствую,-
Наклонился чудак над рукою Тамаркиной...
Пусть Гаолян
Нам навевает сны...

И ушел чудак, не взявши сдачи,
Всем в шалмане пожелал удачи...
Вот какая странная эпоха -
Не горим в огне - и тонем в луже!
Обезьянке было очень плохо,
Человеку было много хуже!
Спите, герои русской земли,
Отчизне родной сыны...
"

http://www.lib.ru/RUSSLIT/ZOSHENKO/r_lenin.txt

Offtopic. Коротко. Ни на что не претендую...

"Поток сознания"?

Вот он настоящий поток сознания:

http://tekst-pesni-tut.ru/song/show/402316/zvuki-mu/tekst-pesni-i-perevod-turist/

"
Кто-то ходит ночью тихо-тихо
Там внизу подо мной
Или это просто бродит вихрь
За моей стеной?
Кто вчера подслушал слово в слово
То о чем я мечтал
Кто так хочет сно-о-ова
Чтобы я не спал?
Мне друзья говорили это турист
Кто мне утром портит дело
Кто будит меня
Кто хочет чтобы не хотела
Меня по утрам жена?
Кто мне утром прячет солнце
Кто со мной грустит целый день
Кто там так похож на японца
В зеркале или это тень?
Мне друзья говорили это турист.
Как мне дальше жить в этом доме
Зачем разбирать кровать
Зачем я деньги экономил
Если их могут отнять?
Куда теперь идти мне не знаю
Жена говорит идем в кино
Но я ее совсем не понимаю
Я молча смотрю в окно
Все кругом говорят появился турист
Все кругом говорят ходит турист
"

Мало?

Читаем тут:

http://www.lib.ru/KSP/mamonow.txt

хотел бы я что бы кто-нибудь дал мне "подстрочный перевод"...

Почему "подстрочный перевод"?

Потому что я - "мало чего у Мамонова понимаю"....

"Чувствую"... Но "не понимаю"...

Коротко. "Просеял тут через сито 30 тыс строк кода"

Просеял тут через сито 30 тыс строк кода... Не только своего.

Первая мысль - "всё переписать".

Бью себя по рукам.

Почему?

Потому, что "если хочется всё переписать", то это "дело не в коде", а в тебе.

Внимательнее надо смотреть.

Другое дело, если не всё, а часть. Малую...

Если только свой, то - "возьми, перепиши и выкини, признай себя дураком".. Раз забыл, что писал...

Но если не только свой, то - внимательнее! Это ведь не дураки писали.

Возможно это ты - что то там - не понимаешь...

Маниловщина. Пишем реализацию IStorage применяя TDD

По мотивам:

1. Ссылка. Пишем простой интерпретатор на C++ с помощью TDD
2. Коротко. О коде и "так бывает"
3. Что я хотел сказать о TDD, но всё как-то недосуг. "Дорога в тысячу ли начинается с одного шага"
4. Что я ещё хочу сказать о TDD (не закончено)

И моей "текущей работы" - хочется написать "серию" - "Пишем реализацию IStorage применяя TDD".

Дело только в чём? В том, что "оно уже написано", но "там есть проблемы".

Посему я это дело - покрываю тестами, которых не было.

Но при этом хочется написать - "как я бы писал с тестами".

Если осилю, то серия получится "постов на двадцать". Но - маниловщина...

Но хочется сделать прям в духе поста - "Ссылка. Пишем простой интерпретатор на C++ с помощью TDD":

1. Пустое хранилище. Открываем на чтение. Получаем ошибку.
2. Пустое хранилище. Открываем на запись. Получаем инициализированное хранилище.
3. Пустое хранилище. Открываем на запись. Потом открываем на чтение. Получаем инициализированное хранилище на чтение.
4. Пустое хранилище. Открываем на запись. Создаём поток в root'е. Проверяем, что поток создался.
5. Пустое хранилище. Открываем на запись. Создаём поддиректорию в root'е. Проверяем, что поддиректория создалась.
6. Пустое хранилище. Открываем на запись. Создаём поток в root'е. Создаём поддиректорию в root'е. Проверяем, что они ОБА создались.
7. Пустое хранилище. Открываем на запись. Создаём поддиректорию в root'е. Создаём поток в root'е. Проверяем, что они ОБА создались.
8. Повторяем предыдущие, два пункта, но при N != 1.
...
M+1. Пустое хранилище. Открываем на запись. Создаём поток в root'е. Проверяем, что поток создался. Удаляем поток. Проверяем, что поток удалился. Проверяем структуру хранилища.
M+2. Пустое хранилище. Открываем на запись. Создаём поддиректорию в root'е. Проверяем, что поддиректория создалась. Удаляем поддиректорию. Проверяем, что поддиректория удалилась. Проверяем структуру хранилища.
...
M1+1. НЕПустое хранилище. Открываем на запись. Создаём поток в root'е. Проверяем, что поток создался. Удаляем поток. Проверяем, что поток удалился. Проверяем структуру хранилища.
M1+2. НЕПустое хранилище. Открываем на запись. Создаём поддиректорию в root'е. Проверяем, что поддиректория создалась. Удаляем поддиректорию. Проверяем, что поддиректория удалилась. Проверяем структуру хранилища.
...
M2+1. Пустое хранилище. Заливаем в него структуру директории с диска. Проверяем как залилось.
M2+2. НЕПустое хранилище. Заливаем в него структуру директории с диска. Проверяем как залилось.
...
M3+1. Пустое хранилище. Заливаем в него структуру директории с диска. Проверяем как залилось. Удаляем выборочно половину залитого. Проверяем как удалилось. Проверяем структуру хранилища.
M3+2. НЕПустое хранилище. Заливаем в него структуру директории с диска. Проверяем как залилось. Удаляем выборочно половину залитого. Проверяем как удалилось. Проверяем структуру хранилища.
...
M4+1. Пустое хранилище. Заливаем в него структуру директории с диска. Проверяем как залилось. Переименовываем выборочно половину залитого. Проверяем как переименовалось. Проверяем структуру хранилища.
M4+2. НЕПустое хранилище. Заливаем в него структуру директории с диска. Проверяем как залилось. Переименовываем выборочно половину залитого. Проверяем как переименовалось. Проверяем структуру хранилища.
...
M5+1. Пустое хранилище. Заливаем в него структуру директории с диска. Проверяем как залилось. Переименовываем выборочно половину залитого. Проверяем как переименовалось. Проверяем структуру хранилища. Удаляем половину от оставшегося. Проверяем как удалилось. Проверяем структуру хранилища.
M5+2. НЕПустое хранилище. Заливаем в него структуру директории с диска. Проверяем как залилось. Переименовываем выборочно половину залитого. Проверяем как переименовалось. Проверяем структуру хранилища. Удаляем половину от оставшегося. Проверяем как удалилось. Проверяем структуру хранилища.
...
M6+1. Пустое хранилище. Заливаем в него структуру директории с диска. Проверяем как залилось. Переименовываем выборочно половину залитого. Проверяем как переименовалось. Проверяем структуру хранилища. Удаляем половину от оставшегося. Проверяем как удалилось. Проверяем структуру хранилища. Переименовываем половину от оставшегося. Проверяем как переименовалось. Проверяем структуру хранилища.
M6+2. НЕПустое хранилище. Заливаем в него структуру директории с диска. Проверяем как залилось. Переименовываем выборочно половину залитого. Проверяем как переименовалось. Проверяем структуру хранилища. Удаляем половину от оставшегося. Проверяем как удалилось. Проверяем структуру хранилища. Переименовываем половину от оставшегося. Проверяем как переименовалось. Проверяем структуру хранилища.
M6+3. Повторяем M6+1 пока хранилище не станет пустым.
M6+4. Повторяем M6+2 пока хранилище не станет пустым.
...

и т.д. и т.п.

- ну и "по индукции" - в итоге тесты должны покрыть 80% функциональности.

Понятное дело, что "где-то Це из Эн по Ка". Никуда не деться от этого.

P.S. Над одним только размышляю пока - писать "на основе реального кода" или "с нуля". И тот и другой вариант - имеет как свои плюсы, так и минусы.

P.P.S. Мне тут правильно товарищ указал - "никакое это не  TDD". Подумаю над этим.

Пора придумывать свой термин? Test-Not-Broken? TNB?

P.P.P.S. "Над одним только размышляю пока - писать "на основе реального кода" или "с нуля". " - тут есть и "третий вариант" - рассмотреть "написание с нуля" vs. "реальный код" - там по крайней мере есть что с чем сравнивать.

Ссылка. PL/I

Почему-то захотелось поделиться ссылкой - PL/I

Я лет двадцать назад читал про него книжку. Ещё папину. И решал задачи из "примеров".

Почему захотелось поделиться?

Там даже числа Фиббоначи или факториалы можно было макросами разворачивать.

В контексте вот этого - О возбуждении исключений

Если найдётся кто-то дотошный - тогда поясню.

Поясню пока лишь вскользь, там можно написать что-то вроде (я синтаксис уже не помню, поэтому использую паскалеподобный):

MACRO NameAndValue (R, A)
begin
 R.Value := A;
 R.Name := '%A%';
end;

Тогда если мы напишем:

TMyRec = record
 Value : Int64;
 Name : String;
end;

var
 myRec : TMyRec;

NameAndValue(myRec, SomeValue)

То это развернётся в:
 myRec.Value := SomeValue;
 myRec.Name := 'SomeValue';

Т.е. те же "шаблоны" из C++, но с "подстановкой".

Я могу путать детали. Скорее всего я их путаю. Но хотелось бы "идею донести".

Почему "обработка исключений"?

А вот почему:

Цитата:

Можно было бы конечно "сочинить" что-то вроде:

Em3InvalidStreamPos.Check(Self.IsValidPosition,
                          aHeader.f_Name,
                          [l_Pos,
                           aHeader.f_TOCItemData.rBody.rRealSize,
                           aHeader.f_TOCItemData.rBody.RTOCBuffRootPosition,
                           aHeader.f_TOCItemData.rBody.RTOCItemListPosition,
                           aHeader.f_TOCItemData.RNextPosition]);

-- но я осознанно этого не делаю.

Т.к. конечно запись короче и "читабельнее". 

Но! В таком варианте - сложнее искать реальный источник ошибки.

Конец цитаты.

А вот если бы можно было бы написать:

Em3InvalidStreamPos.Check(Self.IsValidPosition,
                          [
                           NameAndValue(l_Pos),
                           NameAndValue(aHeader.f_TOCItemData.
                                         rBody.rRealSize),
                           NameAndValue(aHeader.f_TOCItemData.
                                         rBody.RTOCBuffRootPosition),
                           NameAndValue(aHeader.f_TOCItemData.
                                         rBody.RTOCItemListPosition),
                           NameAndValue(aHeader.f_TOCItemData.RNextPosition)
                          ]);

-- тогда - я бы обязательно воспользовался бы подобной конструкцией.

Как бы выглядел бы этот Check?

А вот так:

type
 TNameAndValue = record
  Name : String;
  Value : Int64;
  constructor Create(const aName: String; aValue: Int64);
 end;//TNameAndValue

....

constructor Create(const aName: String; aValue: Int64);
begin
 Name := aName;
 Value := aValue;
end;

MACRO NameAndValue (A)
begin
 TNameAndValue.Create('%A%', A');
end;

class procedure Em3InvalidStreamPos.Check(aCondition: TInt64Predicate; const aValues array of TNameAndValue);
var
 l_V : TNameAndValue;
begin
 for l_V in aValues do
  if not aCondition(l_V.Value) then
   raise Self.CreateFmt('Invalid data: %s = %d', [l_V.Name, l_V.Value]);
end;

-- для разработки и "реального программирования" это конечно же - бред.

А вот для диагностики ошибок - самое то.

В "моих скриптах" я кстати подобное уже сделал.

Повторю тут пару ссылок про for in

Скажем так, по мотивам вот этого - Простой текстовый итератор. Пример использования record в Delphi

Enumerators в Delphi. Часть 1
Enumerators в Delphi. Часть 2
Enumerators в Delphi. Часть 3

Товарищ написал. "К слову про синтаксический сахар"

http://18delphi.blogspot.ru/2013/11/blog-post_7.html?showComment=1383811587483#c8000123285505136429

Ссылка. Идея автогенерации кода при работе с БД

http://www.delphinotes.ru/2011/07/blog-post_14.html

Заслуживает прочтения ИМХО.

Коротко. Об "обратной устойчивости"

Начну "издалека".

С C++. Где оператора with - нет (и слава богу - не будет).

( Зато есть "блочные переменные" и конструкции вида int & X = MyClass.MyField.MySubField; )

Пусть есть код:

class A
{
 private:
  int X; // - это приватный член класса A
};//A

int X = 0; // - это глобальная переменная

class B : A
{
 void Dummy ()
 {
  X = 123; // - тут компилятор ОТРУГАЕТСЯ, скажет - "есть приватный член, 
           //   который может "затенять" глобальную переменную".
 };
};//B

-- в итоге код НЕ СКОМПИЛИРУЕТСЯ.

А как скомпилируется?

А вот так:

class A
{
 private:
  int X; // - это приватный член класса A
};//A

int X = 0; // - это глобальная переменная

class B : A
{
 void Dummy ()
 {
  ::X = 123; // - тут компилятор ругаться не будет, так как "поймёт", 
             //   что X - это ГЛОБАЛЬНАЯ переменная и ТОЛЬКО ОНА
 };
};//B

-- и эта стратегия компилятора - ПРАВИЛЬНАЯ.

Ведь если бы код компилировался, то что бы мы бы могли получить?

А вот что:

class A
{
 protected:
  int X; // - это "защищённый" член класса A
};//A

int X = 0; // - это глобальная переменная

class B : A
{
 void Dummy ()
 {
  X = 123; // - ОБА НА! тут X - "вдруг" стал членом класса A, 
           //   а не глобальной переменной
 };
};//B

-- и мы получаем "неожиданные результаты".

Но! Компилятор так не делает.

Это и называется "обратная устойчивость".

А вот оператор with в Delphi "обратной устойчивостью" не обладает. А жаль.

Поясню:

type
 TA = class
  public
   Caption : String;
 end;//TA

 TB = class
  public
   Caption : String;
   A : TA;
 end;//TB
...
procedure TB.SomeProc;
begin
 with A do
  Caption := '123'; // - это присвоится в Self.A.Caption 
end;

-- а теперь так:

Unit uA;
...
type
 TA = class
  private
   Caption : String;
 end;//TA
...
Unit uB;
...
 TB = class
  public
   Caption : String;
   A : TA;
 end;//TB
...
procedure TB.SomeProc;
begin
 with A do
  Caption := '123'; // - это присвоится в Self.Caption 
end;

-- скажем так - ОГО!

Ну и...

На C++ как можно было бы написать?

void TB::SomeProc ()
{
 ...
 {
  ...
  std::string & vCap = A.Caption;
  vCap = '123';
  ...
 }
 ...
}

-- понятно почему я написал про "переменные блока" и &? И почему "в этом контексте" языку C++ оператор with и не нужен.

Вопрос. Стоит ли писать о выводе стека исключений в лог приложения?

Стоит ли писать о выводе стека исключений в лог приложения?

Или gunsmoker (http://www.gunsmoker.ru/) об этом уже всё исчерпывающе написал?

Вообще тема "косвенного сбора диагностики" от "конечных пользователей" интересна или нет?

Disclaimer. Конечных пользователей я не зря взял в кавычки. Так как у реальных коммерческих пользователей - какой бы то ни было "сбор данных" без их ведома и подписанного договора - это вообще говоря - подсудное дело.

Посему тема-то - касается не только "вывода стека", о и того "как что-то собрать" никого не ущемляя в его правах приватности.

Про "вывод стека" - я написать могу, а вот про "приватность" - с удовольствием других бы послушал.

У реально конечного пользователя - даже дамп стека и данных снять - это "дело подсудное", т.к. в этом дампе легко могут оказаться "приватные данные", например те же логины.

То что "большой брат за нами наблюдает" - не стоит говорить :-) я это тоже знаю и сам лично отношусь к этому - индеффирентно. Но мой работодатель - достаточно щепетилен в этих вопросах. Посему проблема не только в том "как сделать дамп", но и в том - "как его получить".

Но я наверное "всех запутал" своей шизофренией про "приватность". Про дамп стека надо писать? Или все уже в курсе?

Коротко. О фабриках

В некотором смысле в продолжение темы поднятой тут - Коротко. О возбуждении исключений

Отчасти в продолжение вот этой темы - Фабричный метод

Как можно создавать объект?

Ну конечно же так:

type
 TmyObject = class
  public
   constructor Create(aSomeData: TSomeData);
 end;//TmyObject

...
var
 myObject : TmyObject;
...
 myObject := TmyObject.Create(aSomeData);

А можно так:

type
 TmyObject = class
  protected
   constructor Create(aSomeData: TSomeData);
  public
   class function Make(aSomeData: TSomeData): TmyObject;
 end;//TmyObject

...
class function TmyObject.Make(aSomeData: TSomeData): TmyObject;
begin
 if IsValidData(aSomeData) then
  Result := Self.Create(aSomeData)
 else
  Result := nil;
end;
...
var
 myObject : TmyObject;
...
 myObject := TmyObject.Make(theConcreteData);

-- в чём разница? 

А в том, что в "фабричном методе" можно вставить некоторую бизнес-логику.

В нашем случае это - IsValidData(aSomeData).

Но можно пойти дальше:

interface
...
type
 TmyObject = class
  protected
   constructor Create(aSomeData: TSomeData);
   procedure SomeMethodToOverride; virtual;
  public
   class function Make(aSomeData: TSomeData): TmyObject;
 end;//TmyObject
...
implementation
...
 TmySpecialObject = class(TmyObject)
  protected
   procedure SomeMethodToOverride; override;
 end;//TmySpecialObject

...
class function TmyObject.Make(aSomeData: TSomeData): TmyObject;
begin
 if IsMySpecialData(aSomeData) then
  Result := TmySpecialObject.Create(aSomeData) 
 else
 if IsValidData(aSomeData) then
  Result := Self.Create(aSomeData)
 else
  Result := nil;
end;
...
var
 myObject : TmyObject;
...
 myObject := TmyObject.Make(theConcreteData);

А можно пойти ещё дальше:

interface
...
type
 TmyObject = class
  protected
   constructor Create(aSomeData: TSomeData);
   procedure SomeMethodToOverride; virtual;
  public
   class function Make(aSomeData: TSomeData): TmyObject;
 end;//TmyObject
...
implementation
...
 TmyNULLObject = class(TmyObject)
  protected
   procedure SomeMethodToOverride; override;
 end;//TmyNULLObject

 TmySpecialObject = class(TmyObject)
  protected
   procedure SomeMethodToOverride; override;
 end;//TmySpecialObject

...
class function TmyObject.Make(aSomeData: TSomeData): TmyObject;
begin
 if IsMySpecialData(aSomeData) then
  Result := TmySpecialObject.Create(aSomeData) 
 else
 if IsValidData(aSomeData) then
  Result := Self.Create(aSomeData)
 else
  Result := TmyNULLObject.Create(aSomeData);
end;
...
var
 myObject : TmyObject;
...
 myObject := TmyObject.Make(theConcreteData);

Ну и можно пойти и ещё дальше:

interface
...
type
 ImyInterface = interface
  procedure SomeMethodToOverride;
 end;//ImyInterface

 TmyObject = class(TIntefacedObject, ImyInterface)
  protected
   constructor Create(aSomeData: TSomeData);
   procedure SomeMethodToOverride; virtual;
  public
   class function Make(aSomeData: TSomeData): ImyInterface;
 end;//TmyObject
...
implementation
...
 TmyNULLObject = class(TIntefacedObject, ImyInterface)
  protected
   procedure SomeMethodToOverride;
   // - Тут понятное дело override уже не нужен
   constructor Create(aSomeData: TSomeData);
  public
   class function Make(aSomeData: TSomeData): ImyInterface;
   // - а тут вообще говоря можно "забабахать синглетон"
 end;//TmyNULLObject

 TmySpecialObject = class(TmyObject)
  protected
   procedure SomeMethodToOverride; override;
 end;//TmySpecialObject

...
class function TmyObject.Make(aSomeData: TSomeData): ImyInterface;
begin
 if IsMySpecialData(aSomeData) then
  Result := TmySpecialObject.Create(aSomeData) 
 else
 if IsValidData(aSomeData) then
  Result := Self.Create(aSomeData)
 else
  Result := TmyNULLObject.Make(aSomeData);
end;
...
var
 myObject : ImyInterface;
...
 myObject := TmyObject.Make(theConcreteData);

Ну вот собственно и всё.

Надеюсь, что это кому-нибудь понравится.

Опять же оговорюсь, что это всего лишь "макет".

Да!

И ещё одна краткая ремарка.

Как сделать так, чтобы "не прошли мимо фабрики"?

Т.е. чтобы не вызвали "паразитный умолчательный конструктор". Который от TObject.

А вот так:

type
 TmyObject = class
  protected
   constructor Create(aSomeData: TSomeData); overload;
  public
   class function Make(aSomeData: TSomeData): TmyObject;
   constructor Create; overload;
 end;//TmyObject
...
constructor TmyObject.Create;
begin
 Assert(false, 'Надо вызывать фабричный метод, а не унаследованный конструктор');
end;

А можно сделать ещё "веселее", вот так:

type
 TmyObject = class
  protected
   constructor InternalCreate(aSomeData: TSomeData);
  public
   class function Make(aSomeData: TSomeData): TmyObject;
   procedure Create;
 end;//TmyObject
...
procedure TmyObject.Create;
begin
 Assert(false, 'Надо вызывать фабричный метод, а не унаследованный конструктор');
end;

-- тогда ошибочный код вообще компилироваться не будет.

А можно наверное вообще так:

type
 TmyObject = class
  protected
   constructor InternalCreate(aSomeData: TSomeData);
  public
   class function Create(aSomeData: TSomeData): TmyObject;
 end;//TmyObject