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
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:
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.
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.
Комментариев нет:
Отправить комментарий