#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.