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