From 878b51e24f892930623cac84c6718b9f708242a9 Mon Sep 17 00:00:00 2001
From: "J. Gareth \"Curious Kit\" Moreton" <gareth@moreton-family.com>
Date: Thu, 11 Apr 2024 08:15:52 +0100
Subject: [PATCH]   * Floating-point and internal function pure tests

---
 tests/test/tpure4.pp  | 43 ++++++++++++++++++++++++++++++++++++++++++
 tests/test/tpure4a.pp | 43 ++++++++++++++++++++++++++++++++++++++++++
 tests/test/tpure4b.pp | 44 +++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 130 insertions(+)
 create mode 100644 tests/test/tpure4.pp
 create mode 100644 tests/test/tpure4a.pp
 create mode 100644 tests/test/tpure4b.pp

diff --git a/tests/test/tpure4.pp b/tests/test/tpure4.pp
new file mode 100644
index 0000000000..e1d86def84
--- /dev/null
+++ b/tests/test/tpure4.pp
@@ -0,0 +1,43 @@
+{ $OPT=-O2 -Sew }
+
+{$MODE OBJFPC}
+
+program tpure4;
+
+function TestFrac(d : ValReal) : ValReal; pure; [internproc:fpc_in_frac_real];
+
+function intpower(base : Double;exponent : longint) : Double; pure;
+  begin
+    if exponent<0 then
+      begin
+        base:=1.0/base;
+        exponent:=-exponent;
+      end;
+    intpower:=1.0;
+    while exponent<>0 do
+      begin
+        if exponent and 1<>0 then
+          intpower:=intpower*base;
+        exponent:=exponent shr 1;
+        base:=sqr(base);
+      end;
+  end;
+
+function Power(base,exponent : Double) : Double; pure;
+  begin
+    if Exponent=0.0 then
+      result:=1.0
+    else if (base=0.0) and (exponent>0.0) then
+      result:=0.0
+    else if (TestFrac(exponent)=0.0) and (abs(exponent)<=maxint) then
+      result:=intpower(base,trunc(exponent))
+    else
+      result:=exp(exponent * ln (base));
+  end;
+
+begin
+  if Power(2, 3) <> 8.0 then
+    Halt(1);
+
+  WriteLn('ok');
+end.
\ No newline at end of file
diff --git a/tests/test/tpure4a.pp b/tests/test/tpure4a.pp
new file mode 100644
index 0000000000..4f5d99e62d
--- /dev/null
+++ b/tests/test/tpure4a.pp
@@ -0,0 +1,43 @@
+{ $OPT=-O2 -Sew }
+
+{$MODE OBJFPC}
+
+program tpure4a;
+
+function TestFrac(d : ValReal) : ValReal; [internproc:fpc_in_frac_real]; { This should still work even if "pure" is missing }
+
+function intpower(base : Double;exponent : longint) : Double; pure;
+  begin
+    if exponent<0 then
+      begin
+        base:=1.0/base;
+        exponent:=-exponent;
+      end;
+    intpower:=1.0;
+    while exponent<>0 do
+      begin
+        if exponent and 1<>0 then
+          intpower:=intpower*base;
+        exponent:=exponent shr 1;
+        base:=sqr(base);
+      end;
+  end;
+
+function Power(base,exponent : Double) : Double; pure;
+  begin
+    if Exponent=0.0 then
+      result:=1.0
+    else if (base=0.0) and (exponent>0.0) then
+      result:=0.0
+    else if (TestFrac(exponent)=0.0) and (abs(exponent)<=maxint) then
+      result:=intpower(base,trunc(exponent))
+    else
+      result:=exp(exponent * ln (base));
+  end;
+
+begin
+  if Power(2, 3) <> 8.0 then
+    Halt(1);
+
+  WriteLn('ok');
+end.
\ No newline at end of file
diff --git a/tests/test/tpure4b.pp b/tests/test/tpure4b.pp
new file mode 100644
index 0000000000..0cdc6b6b16
--- /dev/null
+++ b/tests/test/tpure4b.pp
@@ -0,0 +1,44 @@
+{ %FAIL }
+{ $OPT=-O2 -Sew }
+
+{$MODE OBJFPC}
+
+program tpure4b;
+
+function TestFrac(d : ValReal) : ValReal; pure; [internproc:fpc_in_frac_real];
+
+function intpower(base : Double;exponent : longint) : Double;
+  begin
+    if exponent<0 then
+      begin
+        base:=1.0/base;
+        exponent:=-exponent;
+      end;
+    intpower:=1.0;
+    while exponent<>0 do
+      begin
+        if exponent and 1<>0 then
+          intpower:=intpower*base;
+        exponent:=exponent shr 1;
+        base:=sqr(base);
+      end;
+  end;
+
+function Power(base,exponent : Double) : Double; pure;
+  begin
+    if Exponent=0.0 then
+      result:=1.0
+    else if (base=0.0) and (exponent>0.0) then
+      result:=0.0
+    else if (TestFrac(exponent)=0.0) and (abs(exponent)<=maxint) then
+      result:=intpower(base,trunc(exponent))
+    else
+      result:=exp(exponent * ln (base));
+  end;
+
+begin
+  if Power(2, 3) <> 8.0 then
+    Halt(1);
+
+  WriteLn('ok');
+end.
\ No newline at end of file