Добавление EurekaLog в программу вызывает EOutOfResources (Out of system resources)

К нам обратился человек, который пожаловался на то, что его приложение работало нормально, пока он не добавил в него EurekaLog. После включения в проекте EurekaLog стало появляться исключение Out of system resources. Исключение возбуждалось вспомогательной функцией OutOfResources из модуля Vcl.Graphics.

Стек вызова для исключения выглядел следующий образом:

  • Vcl.Graphics.OutOfResources
  • Vcl.Graphics.GDIError
  • Vcl.Graphics.GDICheck
  • Vcl.Graphics.TransparentStretchBlt
  • Vcl.Graphics.TBitmap.Draw
  • Vcl.Graphics.TCanvas.Draw
  • SomeComponent.TSomeDBGrid.DrawCell
  • Vcl.Grids.DrawCells
  • Vcl.Grids.TCustomGrid.Paint
  • Vcl.Controls.TCustomControl.PaintWindow
  • Vcl.Controls.TWinControl.PaintHandler
  • Vcl.Controls.TWinControl.WMPrintClient

Само исключение возбуждается такой функцией:

procedure OutOfResources;
begin
raise EOutOfResources.Create(SOutOfResources);
end;

Которая в свою очередь вызывается из:

procedure GDIError;
const
BufSize = 256;
var
ErrorCode: Integer;
Buf: array [Byte] of Char;
begin
ErrorCode := GetLastError;
if (ErrorCode <> 0) and (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, ErrorCode, LOCALE_USER_DEFAULT, Buf, BufSize, nil) <> 0) then
raise EOutOfResources.Create(Buf)
else
OutOfResources;
end;

function GDICheck(Value: THandle): THandle;
begin
if Value = 0 then
GDIError;
Result := Value;
end;

Заметьте, что такая реализация в VCL имеет проблему: вне зависимоси от ошибки возбуждается исключение класса EOutOfResources, даже если ошибка не равна ERROR_NOT_ENOUGH_MEMORY, ERROR_NO_SYSTEM_RESOURCES (или аналогичной). Логичнее было бы возбуждать что-то типа EInvalidGraphicOperation в общем случае и возбуждать EOutOfResources только для ошибок подобного типа.

Из полного баг-отчёта EurekaLog было видно, что показатели памяти и описателей находятся в разумной норме, т.е. проблема не в нехватке памяти. Откуда следует, что (вероятнее всего) GetLastError вернула 0. В самом деле, строка в TransparentStretchBlt, которая проваливает проверку GDICheck выглядит следующим образом:

MemBmp := GDICheck(CreateCompatibleBitmap(SrcDC, SrcW, SrcH));

Из документации видно, что функция CreateCompatibleBitmap не устанавливает значение GetLastError при неудаче.

Впрочем, у функции не так много причин завершиться неудачей: либо ей переданы неверные аргументы, либо ей нехватает памяти для создания bitmap. Заметьте, что нехватка памяти также возможна, если в SrcW и SrcH находится «мусор», который «слишком большой». Таким образом, хотя мы не знаем точную причину неудачи CreateCompatibleBitmap, но мы можем предположить, что проблема — в аргументах.

Значения SrcDC, SrcW и SrcH являются параметрами функции и приходят в неё из TBitmap.Draw:

TransparentStretchBlt
(ACanvas.FHandle, Left, Top, Right - Left, Bottom - Top,
Canvas.FHandle { SrcDC }, 0, 0,
FDIB.dsbm.bmWidth { SrcW }, FDIB.dsbm.bmHeight { SrcH },
MaskDC, 0, 0);

Где Canvas — это поле FCanvas bitmap-а, создаваемое по запросу, а FDIB — поле из FImage: TBitmapImage. Таким образом, все параметры (SrcDC, SrcW и SrcH) приходят в функцию TransparentStretchBlt из полей объекта класса TBitmap.

Следовательно, TBitmap, который пытается рисовать TSomeDBGrid.DrawCell, повреждён. Поскольку исключения не происходит без EurekaLog, но происходит с EurekaLog, то содержимое памяти TBitmap меняется при включении EurekaLog. Наиболее вероятное объяснение такого поведения: ошибка типа «use after free». Без отладочных инструментов в программе код может обратиться к уже удалённому TBitmap и «успешно» выполнить с ним операцию — поскольку память освобождённых объектов не удаляется физически, а лишь помечается как «свободная», без изменения её содежимого. При добавлении в программу EurekaLog её конфигурация по умолчанию включает проверки памяти, которые стирают память при её освобождении.

Проверить эту гипотезу можно изменив настройку «When memory is released» в положение «Do nothing». Если после этого исключение EOutOfResources пропадёт, то в коде имеется ошибка вида «use after free». Наиболее вероятна ошибка в коде SomeComponent, но есть небольшой ненулевой шанс, что клиент нашёл ошибку в VCL.

К сожалению, мы не получили ответа от клиента.

Читать на сайте автора.

Добавление EurekaLog в программу вызывает EOutOfResources (Out of system resources)

К нам обратился человек, который пожаловался на то, что его приложение работало нормально, пока он не добавил в него EurekaLog. После включения в проекте EurekaLog стало появляться исключение Out of system resources. Исключение возбуждалось вспомогательной функцией OutOfResources из модуля Vcl.Graphics.

Стек вызова для исключения выглядел следующий образом:

  • Vcl.Graphics.OutOfResources
  • Vcl.Graphics.GDIError
  • Vcl.Graphics.GDICheck
  • Vcl.Graphics.TransparentStretchBlt
  • Vcl.Graphics.TBitmap.Draw
  • Vcl.Graphics.TCanvas.Draw
  • SomeComponent.TSomeDBGrid.DrawCell
  • Vcl.Grids.DrawCells
  • Vcl.Grids.TCustomGrid.Paint
  • Vcl.Controls.TCustomControl.PaintWindow
  • Vcl.Controls.TWinControl.PaintHandler
  • Vcl.Controls.TWinControl.WMPrintClient

Само исключение возбуждается такой функцией:

procedure OutOfResources;
begin
raise EOutOfResources.Create(SOutOfResources);
end;

Которая в свою очередь вызывается из:

procedure GDIError;
const
BufSize = 256;
var
ErrorCode: Integer;
Buf: array [Byte] of Char;
begin
ErrorCode := GetLastError;
if (ErrorCode <> 0) and (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, ErrorCode, LOCALE_USER_DEFAULT, Buf, BufSize, nil) <> 0) then
raise EOutOfResources.Create(Buf)
else
OutOfResources;
end;

function GDICheck(Value: THandle): THandle;
begin
if Value = 0 then
GDIError;
Result := Value;
end;

Заметьте, что такая реализация в VCL имеет проблему: вне зависимоси от ошибки возбуждается исключение класса EOutOfResources, даже если ошибка не равна ERROR_NOT_ENOUGH_MEMORY, ERROR_NO_SYSTEM_RESOURCES (или аналогичной). Логичнее было бы возбуждать что-то типа EInvalidGraphicOperation в общем случае и возбуждать EOutOfResources только для ошибок подобного типа.

Из полного баг-отчёта EurekaLog было видно, что показатели памяти и описателей находятся в разумной норме, т.е. проблема не в нехватке памяти. Откуда следует, что (вероятнее всего) GetLastError вернула 0. В самом деле, строка в TransparentStretchBlt, которая проваливает проверку GDICheck выглядит следующим образом:

MemBmp := GDICheck(CreateCompatibleBitmap(SrcDC, SrcW, SrcH));

Из документации видно, что функция CreateCompatibleBitmap не устанавливает значение GetLastError при неудаче.

Впрочем, у функции не так много причин завершиться неудачей: либо ей переданы неверные аргументы, либо ей нехватает памяти для создания bitmap. Заметьте, что нехватка памяти также возможна, если в SrcW и SrcH находится «мусор», который «слишком большой». Таким образом, хотя мы не знаем точную причину неудачи CreateCompatibleBitmap, но мы можем предположить, что проблема — в аргументах.

Значения SrcDC, SrcW и SrcH являются параметрами функции и приходят в неё из TBitmap.Draw:

TransparentStretchBlt
(ACanvas.FHandle, Left, Top, Right - Left, Bottom - Top,
Canvas.FHandle { SrcDC }, 0, 0,
FDIB.dsbm.bmWidth { SrcW }, FDIB.dsbm.bmHeight { SrcH },
MaskDC, 0, 0);

Где Canvas — это поле FCanvas bitmap-а, создаваемое по запросу, а FDIB — поле из FImage: TBitmapImage. Таким образом, все параметры (SrcDC, SrcW и SrcH) приходят в функцию TransparentStretchBlt из полей объекта класса TBitmap.

Следовательно, TBitmap, который пытается рисовать TSomeDBGrid.DrawCell, повреждён. Поскольку исключения не происходит без EurekaLog, но происходит с EurekaLog, то содержимое памяти TBitmap меняется при включении EurekaLog. Наиболее вероятное объяснение такого поведения: ошибка типа «use after free». Без отладочных инструментов в программе код может обратиться к уже удалённому TBitmap и «успешно» выполнить с ним операцию — поскольку память освобождённых объектов не удаляется физически, а лишь помечается как «свободная», без изменения её содежимого. При добавлении в программу EurekaLog её конфигурация по умолчанию включает проверки памяти, которые стирают память при её освобождении.

Проверить эту гипотезу можно изменив настройку «When memory is released» в положение «Do nothing» и отключив опцию «Catch memory problems». Если после этого исключение EOutOfResources пропадёт, то в коде имеется ошибка вида «use after free». Наиболее вероятна ошибка в коде SomeComponent, но есть небольшой ненулевой шанс, что клиент нашёл ошибку в VCL.

К сожалению, мы не получили ответа от клиента.

Читать на сайте автора.

Пройди опрос — выиграй лицензию EurekaLog

Правила просты: вы помогаете нам улучшить EurekaLog, принимая участие в опросе. Заполнение анкеты займёт всего несколько минут. По окончании опроса будут выбраны 3 случайных участника.

  • Победители получат одну лицензию Single Developer Enterprise, если у них ещё нет лицензии.
  • Либо победитель получит бесплатное продление срока обслуживания существующей лицензии (на 2 года).

Пройти опрос можно тут.

Опрос завершится 31 января 2021 года. Победители будут объявлены 1 февраля 2021 года. Вы можете пройти опрос только один раз. Дубликаты будут удалены. С победителями свяжутся по электронной почте.

Читать на сайте автора.

Даже в пустых приложениях есть баги

С нами связался человек, который утверждал, что нашёл баг в EurekaLog. Он обосновал это утверждение следующим образом: если создать новое приложение DataSnap и добавить в него EurekaLog, то приложение вылетит с Access Violation при выходе.

При расследовании выяснилось следующее:

  • В модуле данных ServerContainerUnit1 находится компонент сервера DSServer1;
  • Тот же модуль данных содержит два вспомогательных компонента: DSTCPServerTransport1 и DSServerClass1;
  • Оба компонента DSTCPServerTransport1 и DSServerClass1 указывают DSServer1 как «Server»;
  • При выходе приложения модуль данных ServerContainerUnit1 будет уничтожен;
  • Уничтожение модуля данных означает уничтожение всех компонентов в нём — включая DSTCPServerTransport1 и DSServerClass1.

    Вот где это происходит:

    • TDSServerClass.Destroy
    • TComponent.DestroyComponents
    • TDataModule.Destroy

    • TDSTCPServerTransport.Destroy
    • TComponent.DestroyComponents
    • TDataModule.Destroy

    При этом ни TDSServerClass.Destroy, ни TDSTCPServerTransport.Destroy не уведомляют сервер о том, что они уничтожаются. В результате DSServer1 продолжает хранить ссылку на (уже удалённые) DSTCPServerTransport1 и DSServerClass1.

  • Итак, после удаления DSTCPServerTransport1 и DSServerClass1 очистка модуля данных ServerContainerUnit1 продолжается;
  • Настаёт очередь удаления DSServer1. В частности, при этом DSServer1 пытается остановить все зарегистрированные в нём транспорты:
    • TDSCustomServer.StopTransports
    • TDSCustomServer.Stop
    • TDSServer.Stop
    • TDSServer.Destroy
    • TObject.Free
    • TComponent.DestroyComponents
    • TDataModule.Destroy

    что и вызовет Access Violation, поскольку объекты для этих транспортов уже удалены.

Как видим, это — баг в DataSnap, а не в EurekaLog. EurekaLog лишь помогла найти этот баг. Действительно, когда EurekaLog не подключена, то DSServer1 может «успешно» вызвать StopTransports, поскольку память уже удалённых объектов не будет изменена, и вызов методов уже удалённых объектов внутри StopTransports пройдёт «успешно».

Заметьте, что эта ошибка сидит в DataSnap уже целую вечность и её никто не исправляет — ровно потому, что в голом приложении нет средств для её обнаружения. Похожие проблемы есть и в пустом приложении Fire Monkey (FMX), а также во многих стандартных компонентах Delphi.

Конкретно эту ошибку можно обойти, если заставить DSServer1 удаляться первым:

procedure TServerContainer1.DataModuleDestroy(Sender: TObject);
begin
FreeAndNil(DSServer1);
end;

Другие ошибки аналогичного плана нужно исследовать отдельно.

Если же вы не можете исправить ошибку — вы всегда можете выключить проверки памяти в EurekaLog, хотя это и не рекомендуется.

Читать на сайте автора.

Добавление EurekaLog в программу вызывает Integer Overflow?

К нам обратился человек, который пожаловался на то, что его приложение работало нормально, пока он не добавил в него EurekaLog. После включения в проекте EurekaLog стало появляться исключение Integer Overflow. Исключение происходило внутри функции _UStrCatN (функция конкатенации нескольких строк в RTL).

Функция _UStrCatN написана на ассемблере, но если вникнуть в смысл проверок, то получится что-то такое:

  DestLen := {... вычисляется длина результирующей строки ...};      
if DestLen < 0 then
_IntOver;

где _IntOver — это функция RTL, которая и вызывает исключение Integer Overflow.

Что происходит? Как длина строки может быть отрицательной? Это баг в EurekaLog?

Указанная проверка внутри _UStrCatN должна ограничить строки 2 Гб памяти: если результат сложения всех строк будет больше 2 Гб, то произойдёт переполнение, и длина станет отрицательной. Таким образом, Integer Overflow при сложении строк может возникать, если результат слишком большой.

Но при чём тут тогда EurekaLog? И как проверка может срабатывать, если мы складываем небольшие строки? (клиент подтвердил это логом)

Такое «ложно-положительное» срабатывание возможно, если вы проводите операцию с уже удалённой строкой.

Посмотрите на такой код:

var
Marker: String;

function ReadLine: String;
begin
// ...
Marker := { ... };
// ...
end;

begin
// ...
Data := Data + Marker + ReadLine;
// ...
end;

Видите ли вы проблему в этом коде?

Чтобы понять проблему, нужно знать как выполняется строка «Data := Data + Marker + ReadLine;«. На псевдо-коде это выглядит как-то так:

Param0 := Pointer(Data);
Param1 := Pointer(Marker);
Param2 := Pointer(ReadLine);
_UStrCatN(Data, [Param0, Param1, Param2]);

Иными словами, оператор последовательно сохраняет указатели на аргументы, прежде чем вызвать функцию.

Вот вам и проблема: оператор сохраняет указатель на строку Marker, но строка Marker меняется внутри функции ReadLine. Это означает, что сохранённый указатель будет указывать на старую строку. Таким образом, на вход функции _UStrCatN попадёт уже удалённая строка.

Заметьте, что без EurekaLog в проекте этот баг не является «проблемой». Действительно, удалённая память просто помечается как свободная, но её содержимое не очищается. Это значит, что _UStrCatN успешно проведёт конкатенацию с уже удалённой строкой. И результат операции, скорее всего, будет корректным. Т.е. баг в коде есть, но его совершенно не видно, поскольку программа функционирует полностью правильно.

Ситуация меняется в корне, если в проект добавляется EurekaLog (или любой другой инструмент для отладки проблем с памятью). По умолчанию в EurekaLog включены проверки памяти. Это означает, что удалённая память будет очищена. Как правило, это делается шаблоном вроде DEADBEEF. Заметьте, что Integer представление DEADBEEF — отрицательно (равно -559038737). Т.е. прибавление к этому числу длин нескольких небольших строк также даст отрицательное число.

Иными словами, если в проект добавлена EurekaLog, то операция с уже удалённой строкой больше не будет успешной. Ранее скрытый баг теперь виден.

Читать на сайте автора.

Почему в выводе echo командной строки с перенаправлением появляется 1? Кто вставляет эти единицы?

Это перевод Why does my command line redirection echo with an extra 1? Who’s inserting these rogue 1s everywhere? Автор: Реймонд Чен.

Если вы оставите включённым

Читать на сайте автора.

Почему в выводе echo командной строки с перенаправлением появляется 1? Кто вставляет эти единицы?

Это перевод Why does my command line redirection echo with an extra 1? Who’s inserting these rogue 1s everywhere? Автор: Реймонд Чен.

Если вы оставите включённым

Читать на сайте автора.

Добавление EurekaLog в программу вызывает Access Violation?

К нам обратился человек, который пожаловался на то, что его приложение работало нормально, пока он не добавил в него EurekaLog. После включения в проекте EurekaLog стало появляться исключение AccessViolation с текстом Access violation at address 00E15025 in module ‘Project.exe’. Read of address 83EC8B69 и таким стеком:

  • Contoso.pas TContosoEventMessage.BasePerform
  • Vcl.Forms.pas TApplication.WndProc
  • System.Classes.pas StdWndProc
  • Vcl.Forms.pas TApplication.HandleMessage
  • Vcl.Forms.pas TApplication.Run
  • Project.dpr Initialization

(все имена заменены; Contoso — это некая известная библиотека для Delphi).

Воспроизводимый пример человек предоставить не захотел, но, к счастью, у нас был доступ к исходному коду библиотеки.

Адрес в сообщении об ошибке (83EC8B69 — «случайный») и короткий стек могут указывать на проблему «управление ушло по мусорному указателю и вылетело в случайном месте». К сожалению, в отчёте не были включены секции CPU и ассемблера (отключены в настройках). В этом случае диагностика по исходному коду была бы невозможной. Признаться, я сначала хотел так и ответить, дав рекомендацию по усилению контроля за памятью.

Но вот именно такой стек возможен также в случае, если BasePerform вызывается главным потоком как процедура, поставленная в очередь для Synchronize. И действительно — поиск по исходникам выдал такой код:

function TContosoEventMessage.Perform(AThread: TContosoThread): Boolean;
begin
FMsgThread := AThread as TContosoEventThread;
if FMsgThread.Active then begin
if FMsgThread.Options.Synchronize then
TContosoThread.Queue(nil, BasePerform)
else
BasePerform;
end;
Result := True;
end;

Т.е. у класса сообщения есть функция для обработки этого сообщения. И если в опциях чего-то там указан флаг Synchronize, то непосредственно обработка сообщения (BasePerform) будет выполнена не в текущем потоке, а будет отправлена на выполнение в главный поток — через TThread.Queue.

И да, в отчёте также был виден этот фоновый поток от Contoso, который мог бы выполнить такой код.

Сам метод BasePerform является просто обёрткой вокруг InternalHandle:

procedure TContosoEventMessage.BasePerform;
begin
FMsgThread.InternalHandle(Self);
end;

И отчёт EurekaLog показывает, что вылет произошёл на первой же строчке.

Что мы имеем?

  1. Фоновый поток поставил в очередь метод, заполнив поле FMsgThread.
  2. Главный поток попробовал выполнить этот метод и вылетел при попытке прочитать поле FMsgThread.

Вторая строка является предположением, поскольку, как я уже сказал, ассемблера в отчёте не было. Но гипотеза вполне себе, поскольку если иначе вылет был бы внутри InternalHandle.

Т.е. вроде как налицо проблема с памятью. И, кстати говоря, это самая частая «проблема» проектов, которые включают EurekaLog. В самом деле, посмотрите на такой код:

procedure TForm1.Button1Click(Sender: TObject);
var
List: TList;
begin
List := TList.Create;
List.Free;

List.Clear; // - использование объекта после удаления
end;

Корректный ли это код? Нет, конечно. Но будет ли он «работать». Да, с большой вероятностью он корректно отработает. Происходит это по той простой причине, что «освобождённая» память (и, следовательно, «освобождённый» объект) в действительности не удаляются, а просто помечаются как свободные. Т.е. их память остаётся доступной в неизменном виде. Конечно, если между особождением памяти/объекта и повторным доступом к нему будет много операций, то есть какой-то шанс, что они испортят бывшую память. Но на коротких пробегах вы не заметите проблемы.

Добавление EurekaLog в программу меняет ситуацию на корню, поскольку EurekaLog по умолчанию включает проверки памяти и активно борется с указанными багами.

Что-ж, посмотрим может ли у нас сейчас быть такая ситуация. Для этого нужно понять где освобождается память для FMsgThread. Поскольку он приходит из параметра метода — посмотрим, кто вызывает метод BasePerform. Поиск по исходникам подсказал такой код (поиск показал несколько мест, но конкретное место было выбрано исходя из состояние фонового потока из отчёта):

procedure TContosoThread.Execute;
// ...
begin
// ...
for i := 0 to oReceivedMsgs.Count - 1 do
begin
oMsg := TContosoThreadMsgBase(oReceivedMsgs[i]);
try
if not oMsg.Perform(Self) then
Break;
finally
oMsg.Destroy;
end;
// ...
end;

Оп, а вот он и баг. Сценарий происходящего:

  1. Фоновый поток перебирает входящие сообщения.
  2. Каждое сообщение обрабатывается (Perform).
  3. Какое-то сообщение указывает, что его нужно синхронизировать в главный поток.
  4. Фоновый поток ставит сообщение в очередь (Queue).
  5. Фоновый поток удаляет сообщение (Destroy), но указатель на сообщение всё ещё сидит в очереди.
  6. Главный поток приступает к обработке запланированных сообщений (BasePerform).
  7. Обработка сообщения вызывает Access Violation, потому что сообщение уже удалено.

Т.е. баг тут либо в управлении памятью, либо в синхронизации потоков. Как возникла такая ошибка? Очевидно, изначально были написаны базовые классы, которые предполагали линейное выполнение: «взяли сообщение — обработали — освободили». Потом был написан особый класс-наследник, который переопределил поведение «обработать» на «поставить в очередь и выйти». А базовый класс (с циклом) про это не в курсе. Что и привело к багу.

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

Я подозреваю, что исправление проблемы могло бы быть в замене Queue на Synchronize.

Вот такое расследование получилось — исключительно по исходному коду незнакомой библиотеки и неполному отчёту о вылете, не имея перед собой рабочего примера.

Читать на сайте автора.

Ответ на задачку №26

Ответ на задачку №26.

Не сказать, что было много вариантов ответов, но один ответ был достаточно близок к истине. Да, задачка была сильно неочевидная.

Напомню код функции:

function InitDeflate(const ACompressionLevel: Byte): TZStreamRec;
var
Code: Integer;
begin
FillChar(Result, SizeOf(Result), 0);
Code := System.ZLib.deflateInit_(Result, ACompressionLevel, zlib_version, SizeOf(TZStreamRec)));

// ... далее идёт анализ Code
// в данном случае Code = Z_OK
end;

Запись TZStreamRec выглядит так:

type
TZStreamRec = record
next_in: PByte; // следующий входной байт
avail_in: Cardinal; // число байт в next_in
total_in: LongWord; // сколько уже байт прочитали
next_out: PByte; // сюда будет записан следующий выходной байт
avail_out: Cardinal; // сколько осталось свободного места в next_out
total_out: LongWord; // сколько всего байт записали
msg: PAnsiChar; // последнее сообщение об ошибке, nil если ошибки не было
state: Pointer; // недокументировано
zalloc: alloc_func; // для выделения памяти для state
zfree: free_func; // для освобождения памяти state
opaque: Pointer; // "непрозрачный" параметр для zalloc и zfree
data_type: Integer; // возможный тип данных (двоичные/текст) для сжатия,
// или состояние процесса для распаковки
adler: LongWord; // контрольная сумма распакованных данных
reserved: LongWord; // зарезервированно, должно быть 0
end;

Короче говоря, это достаточно простая функция-обёртка. И обычно она будет работать без проблем. Вернее, она-то всегда будет работать нормально — в том смысле, что она всегда будет возвращать Z_OK. Но иногда любая попытка воспользоваться результатом функции (например, в вызове deflate) вернёт ошибку Z_STREAM_ERROR в первом же вызове!

Проблема кроется в недокументированном поле state. Если мы откроем исходники ZLib, то увидим такой код (сокращено):

typedef struct internal_state {
z_streamp strm; /* указатель на TZStreamRec, которому принадлежит это состояние */
int status; /* как следует из названия */
/* ... */

Иными словами, поле state — это указатель на запись, в поле которой записывается указатель на родительскую запись (TZStreamRec). Что-то вроде Owner-а у классов. Проблема в том, что записи — это не классы. Их экземпляры передаются по значению, а не по ссылке (как объекты). Это значит, что если мы присвоим TZStreamRec другой переменной — это скопирует все поля записи в новую область памяти (переменную). У этой переменной будет свой собственный адрес, не совпадающий со старым. В то же время операция присваивания ничего не знает про поле state, поэтому оно не будет изменено и продолжит указывать на старую запись. Вызов deflate увидит, что указатель strm не указывает на валидную запись TZStreamRec и вернёт Z_STREAM_ERROR.

Но где же проблема? Действительно, при вызове функции компилятор передаст в неё указатель на переменную (обычно — стек), внутри функции этот указатель будет передан сначала в FillChar, а затем и в deflateInit. Поскольку всюду запись передаётся по указателю — проблем быть не должно:

; ZLIBStream := InitDeflate(9);
lea ecx,[ebp-$4d]
mov al,$09
call InitDeflate

Но иногда компилятор может решить сделать такое:

; ZLIBStream := InitDeflate(9);
mov rcx,rbp
lea rdx,[rbp+$48]
mov r8b,$09
call InitDeflate
lea rdi,[rbp+$000000b0]
lea rsi,[rbp+$48]
mov ecx,$0000000c
rep movsq

Т.е. на псевдокоде:

Tmp := InitDeflate(9);
ZStream := Tmp;

Вот вам и копирование. Вот вам и проблема.

Не сказать, что это прям совсем баг. Да, это лишняя операция. Да, её делать не нужно. Но она технически корректна, и компилятор имеет полное право её выполнить.

Чья же здесь ошибка? Я считаю, что программиста. Мы неявно использовали допущение о внутренней реализации. Это примерно как задачка №13.

Как это можно исправить? Передавать ссылку явно:

procedure InitDeflate(const ACompressionLevel: Byte; out Result: TZStreamRec);
var
Code: Integer;
begin
FillChar(Result, SizeOf(Result), 0);
Code := System.ZLib.deflateInit_(Result, ACompressionLevel, zlib_version, SizeOf(TZStreamRec)));

// ...
end;

Разумеется, если вы делаете все операции в рамках одной функции, то эта проблема также не стоит.

P.S. Я ругался на «нововведения» ZLib, потому что «ранее этот код работал» (со старой ZLib) и упоминания о такой детали реализации или же требовании я в документации не нашёл. Но пока писал ответ, мне пришло в голову, что, возможно, дело в компиляторе Delphi. Возможно, где-то когда-то что-то поменяли. И ранее там не было скрытой временной переменной, а реализация в ZLib не менялась. Возможно. Я не знаю.

Читать на сайте автора.

Как можно заклинить виртуальный картридер?

Это перевод How is it possible to jam a virtual card reader? Автор: Реймонд Чен.

Когда-то давно я поддерживал систему с разделением времени, известную как VM/CMS.

Читать на сайте автора.