+ support TP7-compatible @proc^ (as in FillChar(@proc^,...))

git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@39343 3ad0048d-3df7-0310-abae-a5850022a9f2

2 files changed, 54 insertions, 0 deletions

diff --git a/tests/tbs/tb0646a.pp b/tests/tbs/tb0646a.pp
new file mode 100644
index 0000000000..fb26be4766
--- /dev/null
+++ b/tests/tbs/tb0646a.pp
@@ -0,0 +1,27 @@
+program tb0646a;
+
+{$MODE TP}
+
+procedure TestProc;
+begin
+  Writeln('Hello');
+end;
+
+var
+  arr1,
+  arr2,
+  arr3: array [1..10] of Byte;
+
+begin
+  Move(TestProc, arr1, 10);
+  Move((@TestProc)^, arr2, 10);
+  Move(@TestProc^, arr3, 10);
+  if (CompareByte(arr1, arr2, 10) <> 0) or
+     (CompareByte(arr2, arr3, 10) <> 0) then
+  begin
+    Writeln('Error!');
+    Halt(1);
+  end
+  else
+    Writeln('Ok!');
+end.
diff --git a/tests/tbs/tb0646b.pp b/tests/tbs/tb0646b.pp
new file mode 100644
index 0000000000..7ec6a2ffcb
--- /dev/null
+++ b/tests/tbs/tb0646b.pp
@@ -0,0 +1,27 @@
+program tb0646b;
+
+{$MODE DELPHI}
+
+procedure TestProc;
+begin
+  Writeln('Hello');
+end;
+
+var
+  arr1,
+  arr2,
+  arr3: array [1..10] of Byte;
+
+begin
+  Move(TestProc, arr1, 10);
+  Move((@TestProc)^, arr2, 10);
+  Move(@TestProc^, arr3, 10);
+  if (CompareByte(arr1, arr2, 10) <> 0) or
+     (CompareByte(arr2, arr3, 10) <> 0) then
+  begin
+    Writeln('Error!');
+    Halt(1);
+  end
+  else
+    Writeln('Ok!');
+end.