mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-12 14:29:34 +02:00
fd42c3fb01
(which are not supported on all unix targets; feel free to re-enable for
specific unix targets if the test has been verified to compile there)
o also fixed placement of dotest directives: they have to come before any
part of the program code
git-svn-id: trunk@41717 -
114 lines
3.1 KiB
ObjectPascal
114 lines
3.1 KiB
ObjectPascal
{ %target=win32,win64,linux }
|
|
{ %cpu=i386,x86_64 }
|
|
{ %opt=-O1 }
|
|
|
|
program tw35187;
|
|
|
|
{ NOTE: SIGSEGV won't trigger if GetMem is used because it allocates pages from a large pre-reserved heap. [Kit] }
|
|
|
|
{$IFDEF TARGET_VALID}
|
|
{$UNDEF TARGET_VALID}
|
|
{$ENDIF TARGET_VALID}
|
|
|
|
{$IFDEF WINDOWS}
|
|
uses
|
|
Windows;
|
|
{$DEFINE TARGET_VALID}
|
|
{$ENDIF}
|
|
{$IFDEF UNIX}
|
|
uses
|
|
BaseUnix, SysCall;
|
|
|
|
function fpmprotect(Addr: Pointer; Len: PtrUInt; Prot: LongInt): LongInt; inline;
|
|
begin
|
|
fpmprotect := Do_SysCall(syscall_nr_mprotect, TSysParam(Addr), Len, Prot);
|
|
end;
|
|
{$DEFINE TARGET_VALID}
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF TARGET_VALID}
|
|
{$ERROR No memory allocation routine available }
|
|
{$ENDIF TARGET_VALID}
|
|
|
|
const
|
|
TestBlock: packed array[0..127] of Char = 'The quick brown fox jumps over the lazy dog, Victor jagt zw'#148'lf Boxk'#132'mpfer quer '#129'ber den gro'#225'en Sylter Deich.'#10#13'0123456789?!"#%'#251#253#252;
|
|
|
|
Expected: packed array[0..255] of Char = '54686520717569636B2062726F776E20666F78206A756D7073206F76657220746865206C617A7920646F672C20566963746F72206A616774207A77946C6620426F786B846D70666572207175657220816265722064656E2067726FE1656E2053796C7465722044656963682E0A0D303132333435363738393F21222325FBFDFC';
|
|
|
|
HexDigits: packed array[0..$F] of Char = '0123456789ABCDEF';
|
|
|
|
var
|
|
Buf: packed array[0..255] of Char;
|
|
HexPtr: PChar;
|
|
P: PByte;
|
|
I: DWord;
|
|
HeapBlock, HeapMarker: PByte;
|
|
begin
|
|
WriteLn(TestBlock);
|
|
FillChar(Buf, SizeOf(Buf), 0);
|
|
|
|
{ Reserve two 4K memory pages: one that is read-write followed by one that
|
|
has no access rights at all and will trigger SIGSEGV if encroached }
|
|
{$IFDEF WINDOWS}
|
|
HeapBlock := VirtualAlloc(
|
|
VirtualAlloc(nil, 8192, MEM_RESERVE, PAGE_READWRITE),
|
|
4096,
|
|
MEM_COMMIT,
|
|
PAGE_READWRITE
|
|
);
|
|
if not Assigned(HeapBlock) then
|
|
begin
|
|
WriteLn('Memory allocation failure');
|
|
Halt(1);
|
|
end;
|
|
HeapMarker := HeapBlock + 3968; { 4096 - 128 }
|
|
{$ENDIF WINDOWS}
|
|
{$IFDEF UNIX}
|
|
HeapBlock := fpmmap(nil, 8192, PROT_NONE, MAP_ANON or MAP_PRIVATE, -1, 0);
|
|
if not Assigned(HeapBlock) or (fpmprotect(HeapBlock, 4096, PROT_READ or PROT_WRITE) <> 0) then
|
|
begin
|
|
WriteLn('Memory allocation failure');
|
|
Halt(1);
|
|
end;
|
|
|
|
HeapMarker := HeapBlock + 3968; { 4096 - 128 }
|
|
{$ENDIF UNIX}
|
|
|
|
Move(TestBlock, HeapMarker^, SizeOf(TestBlock));
|
|
HexPtr := @Buf;
|
|
|
|
for I := 0 to SizeOf(TestBlock) - 1 do
|
|
begin
|
|
P := HeapMarker + I;
|
|
|
|
HexPtr^ := HexDigits[P^ shr 4]; { first nybble }
|
|
Write(HexPtr^);
|
|
Inc(HexPtr);
|
|
|
|
{ #35187: This instruction causes an access violation on the last byte
|
|
because it tries to read a word instead of a byte. }
|
|
|
|
HexPtr^ := HexDigits[P^ and $F]; { second nybble }
|
|
Write(HexPtr^);
|
|
Inc(HexPtr);
|
|
end;
|
|
|
|
{$IFDEF WINDOWS}
|
|
VirtualFree(HeapBlock, 0, MEM_RELEASE);
|
|
{$ENDIF WINDOWS}
|
|
{$IFDEF UNIX}
|
|
fpmunmap(HeapBlock, 8192);
|
|
{$ENDIF UNIX}
|
|
|
|
WriteLn();
|
|
|
|
for I := 0 to SizeOf(TestBlock) - 1 do
|
|
if Buf[I] <> Expected[I] then
|
|
begin
|
|
WriteLn('Error at index ', I, '; expected ', Expected[I], ' got ', Buf[I]);
|
|
Halt(1);
|
|
end;
|
|
|
|
WriteLn('ok');
|
|
end.
|