Browse Source

+ new test for issue #5641

git-svn-id: trunk@4478 -
florian 19 years ago
parent
commit
35c58e24b4
2 changed files with 24 additions and 0 deletions
  1. 1 0
      .gitattributes
  2. 23 0
      tests/webtbs/tw5641.pp

+ 1 - 0
.gitattributes

@@ -7247,6 +7247,7 @@ tests/webtbs/tw5086.pp -text
 tests/webtbs/tw5094.pp -text
 tests/webtbs/tw5100.pp svneol=native#text/plain
 tests/webtbs/tw5100a.pp svneol=native#text/plain
+tests/webtbs/tw5641.pp svneol=native#text/plain
 tests/webtbs/tw6203.pp svneol=native#text/plain
 tests/webtbs/tw6435.pp svneol=native#text/plain
 tests/webtbs/tw6491.pp svneol=native#text/plain

+ 23 - 0
tests/webtbs/tw5641.pp

@@ -0,0 +1,23 @@
+// Title: bad construction status of object.
+{$C+}
+uses Objects;
+
+var
+  mempool: Pointer;
+  obj: PObject;
+begin
+  GetMem(mempool, $2000000);
+  Assert(mempool<>nil, 'GetMem failed');
+  obj:=Pointer((Cardinal(mempool) or $FF));
+  Assert(obj^.init, 'case 1a ((addr and $FF) <> 0)');
+  Assert(obj^.init, 'case 1b ((addr and $FF) <> 0)');
+  Assert(obj^.init, 'case 1c ((addr and $FF) <> 0)');
+  obj:=Pointer((Cardinal(mempool) or $FF) + 1);
+  Assert(obj^.init, 'case 2 (addr=$xxxxxx00)');
+  obj:=Pointer((Cardinal(mempool) or $FFFF) + 1);
+  Assert(obj^.init, 'case 3 (addr=$xxxx0000)');
+  obj:=Pointer((Cardinal(mempool) or $FFFFFF) + 1);
+  Assert(obj^.init, 'case 4 (addr=$xx000000)');
+  FreeMem(mempool);
+  writeln('ok');
+end.