From cf3faba5a29c652a49c1c1f47a80aed2537726f8 Mon Sep 17 00:00:00 2001
From: "J. Gareth \"Curious Kit\" Moreton" <gareth@moreton-family.com>
Date: Sun, 30 Apr 2023 15:20:19 +0100
Subject: [PATCH] * Added test to attempt to catch access violation caused by
faulty optimisation (i40165)
---
tests/webtbs/tw40165.pp | 33 +++++++++++++++++++++++++++++++++
tests/webtbs/tw40165a.pp | 2 ++
tests/webtbs/tw40165b.pp | 2 ++
3 files changed, 37 insertions(+)
create mode 100644 tests/webtbs/tw40165.pp
create mode 100644 tests/webtbs/tw40165a.pp
create mode 100644 tests/webtbs/tw40165b.pp
diff --git a/tests/webtbs/tw40165.pp b/tests/webtbs/tw40165.pp
new file mode 100644
index 0000000000..41fa1b3df5
--- /dev/null
+++ b/tests/webtbs/tw40165.pp
@@ -0,0 +1,33 @@
+{ %OPT=-O1 }
+
+{ This test attempts to catch the incorrect optimisation that occurred
+ sometimes when CMOV was allowed to use a normally-unsafe reference.
+ The code in question borrows from TObject.GetInterfaceByStr, where
+ the fault was first detected }
+
+program tw40165;
+
+{$mode objfpc} {$modeswitch advancedrecords}
+type
+ InterfaceEntry = record
+ iid: ^pInt32;
+ function GetIID: pInt32; inline;
+ end;
+
+ function InterfaceEntry.GetIID: pInt32;
+ begin
+ if Assigned(iid) then result := iid^ else result := nil;
+ end;
+
+var
+ ieStore: InterfaceEntry = (iid: nil);
+ ie: ^InterfaceEntry = @ieStore;
+
+begin
+ if Assigned(ie) and Assigned(ie^.GetIID) then
+ begin
+ writeln('FAIL - condition incorrect');
+ halt(1);
+ end;
+ writeln('ok');
+end.
diff --git a/tests/webtbs/tw40165a.pp b/tests/webtbs/tw40165a.pp
new file mode 100644
index 0000000000..cffe439077
--- /dev/null
+++ b/tests/webtbs/tw40165a.pp
@@ -0,0 +1,2 @@
+{ %OPT=-O2 }
+{$I tw40165.pp}
\ No newline at end of file
diff --git a/tests/webtbs/tw40165b.pp b/tests/webtbs/tw40165b.pp
new file mode 100644
index 0000000000..0ed7333b4b
--- /dev/null
+++ b/tests/webtbs/tw40165b.pp
@@ -0,0 +1,2 @@
+{ %OPT=-O3 }
+{$I tw40165.pp}
\ No newline at end of file