пятница, 13 января 2017 г.

#1333. Функция-помощник для стрессового тестирования длинных 64-битных адресов на предмет совместимости с Integer

Функция-помощник для тестирования длинных 64-битных адресов на предмет совместимости с Integer. Творческая переработка идей gunsmoker'а и Николая Зверева.

По мотивам:
http://programmingmindstream.blogspot.ru/2016/12/1330-win64.html
http://www.delphinotes.ru/2016/10/win64-2.html

unit l3DebugUtils;

interface

procedure l3ReserveMem;

implementation

uses
 Windows
 ;

procedure l3ReserveMem;
{$IfDef Win64}
var
 l_P : Pointer;
begin
 while true do
 begin
  l_P := VirtualAlloc(nil, 1024 * 1024, MEM_RESERVE, PAGE_NOACCESS);
  // - распределяем по мегабайту, пока не выберем "младшее" адресное пространство (меньше 4Гб).
  if (l_P = nil) then
   break;
  if (NativeUInt(l_P) >= High(Cardinal{Integer})) then
   break;
 end;//while true
end;
{$Else  Some64}
begin
end;
{$EndIf Some64}

end.


Втыкаем вызов l3ReserveMem первой строчкой в dpr и получаем, что все далее распределённые адреса будут больше $FFFFFFFF.

Далее протыкиваем наше приложение или запускаем автоматические тесты. И ловим Range Check'и и AV. Там где Pointer приводится к Integer и Cardinal и наоборот. В прямую сторону Range Check в обратную - скорее всего AV.

Я много чего наловил. И в чужом коде - тоже. В частности в ImageEn. Например в функции _DIBDrawTo. Но об этом в другой раз.

Этот код можно и в релизе оставить. И тренироваться "на пользователях".



У меня вызов функции в тестах вот так вставлен:


begin
 {$IfDef nsTest}
 g_CVSPath := 'w:\common\components\DailyTest';
 {$EndIf nsTest}
 //#UC START# *4B2A48AA03D4CVSPath*
 l3ReserveMem;
 //#UC END# *4B2A48AA03D4CVSPath*
 TAutoTestsSuite.Register;
 try
  if KTestRunner.NeedKTestRunner([TtoK, TItsLAW, TArchi2, TtoK64, TtoKT]) then
   KTestRunner.RunRegisteredTests
  else
  if System.IsConsole then
   TextTestRunner.RunRegisteredTests
  else
   GUITestRunner.RunRegisteredTests;
 except
  on E: Exception do
  begin
   {$If defined(MTDORB) AND defined(NoKPageTool)}
   if TKBridge.Exists then
    TKBridge.Instance.Logout;
   {$IfEnd}
   l3System.Exception2Log(E);
   TestsExitCode := 2;
  end;//Exception
 end;//try..except
{$IfNDef Some64}
 if (TestsExitCode <> 0) then
  Halt(TestsExitCode);
{$EndIf  Some64}
end.

9 комментариев:

  1. Хм... у меня тоже сначала цикл был с проверкой, очень похожей:
    if (NativeUInt(l_P) >= High(Cardinal{Integer})) then
    break;

    Но у меня (на моём ПК) выход из цикла завершался после небольшого кол-ва итераций (иногда даже после первой), а затем, по ходу работы приложения память выделялась в первых двух гигах.

    Была ещё мысль подменить менеджер памяти и эту проверку делать в GetMem

    ОтветитьУдалить
    Ответы
    1. Ну. Свою задачу я пока решил. И у меня явно не после первой итерации. Ну и потом - тут же VirtualAlloc, а не GetMem. Да ещё и noAccess. Что тоже полезно. Гарантирует AV. Если я правильно понимаю.

      Удалить
    2. Для "гарантии" можно насильно сделать High(Cardinal) div Size итераций.
      Главная идея была не в этом, а именно в использовании VirtualAlloc, а не GetMem.

      Удалить
  2. Да, что-то я совсем не внимательно прочитал код.

    ОтветитьУдалить
  3. Охохох - робята, вот это вы меня в грусть ввергли.
    У меня падение за падением - ничего себе работки то поприбавилось.
    Но за идею - респект.

    ОтветитьУдалить
  4. Спасибо за модуль! Буквально спас проект на 64х.

    ОтветитьУдалить
  5. В FastMM есть опция AlwaysAllocateTopDown (включена по умолчанию).

    Также в 32-битных Windows можно включить Allocate Top Down для тестирования > 2 Гб: https://docs.microsoft.com/en-us/windows/win32/memory/4-gigabyte-tuning (см. про ключ реестра AllocationPreference).

    ОтветитьУдалить