четверг, 26 января 2017 г.

#1341. Helper routine for stress testing large 64 bit addresses to be correct with integer casts

Helper routine for stress testing large 64 bit addresses to be correct with integer casts.

Useful for porting from 32 to 64 bits.

Original in russian - http://programmingmindstream.blogspot.ru/2017/01/1333-64-integer.html.

Idea from gunsmoker'а and Николай Зверев.

Links:
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);
  // - reserve by one megabyte while low addresses not ended (less 4Gb).
  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.


Put call to l3ReserveMem at first line of dpr and get the fact that all addresses later will be greater than $FFFFFFFF.

Then test our application and wait for AV or Range Check.

Pay attention to PAGE_NOACCESS - thus low adresses is not readable or writeable.

This code can be left in release build for user. It's not reserve real memory but only address space.



I have this call in my tests:


begin
 {$IfDef nsTest}
 g_CVSPath := 'w:\common\components\DailyTest';
 {$EndIf nsTest}
 //#UC START# *4B2A48AA03D4CVSPath*
 l3ReserveMem; // !!! HERE !!!
 //#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.

Комментариев нет:

Отправить комментарий