On May 12, 2022, Pierre-Marie de Rodat <dero...@adacore.com> wrote:
> Implement and document hardened booleans, from nonstandard boolean types
> with representation clauses to the extra validity checking performed on
> boolean types annotated with the "hardbool" Machine_Attribute pragma.
And here is a test for testsuite/gnat.dg. Tested on x86_64-linux-gnu.
I'm checking this in.
Introduce tests for hardbool Machine_Attribute for Ada
Test for the validity checking performed on nonstandard booleans
annotated with the "hardbool" Machine_Attribute pragma.
for gcc/testsuite/ChangeLog
* gnat.dg/hardbool.ads: New.
* gnat.dg/hardbool.adb: New.
---
gcc/testsuite/gnat.dg/hardbool.adb | 46 ++++++++++++++++++++++++++++++++++++
gcc/testsuite/gnat.dg/hardbool.ads | 22 +++++++++++++++++
2 files changed, 68 insertions(+)
create mode 100644 gcc/testsuite/gnat.dg/hardbool.adb
create mode 100644 gcc/testsuite/gnat.dg/hardbool.ads
diff --git a/gcc/testsuite/gnat.dg/hardbool.adb
b/gcc/testsuite/gnat.dg/hardbool.adb
new file mode 100644
index 0000000000000..cc38af06a79b7
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/hardbool.adb
@@ -0,0 +1,46 @@
+-- { dg-do compile }
+-- { dg-options "-O -gnatVT -fdump-tree-optimized" }
+
+-- Check that we perform the expected validity checks for
+-- hardbool-annotated types, even when checking of tests is disabled.
+
+package body Hardbool is
+ function T return Boolean is (Boolean (X) and then Boolean (Y));
+
+ procedure P1 is
+ begin
+ X := HBool1 (not Y);
+ end P1;
+
+ procedure P2 is
+ begin
+ X := HBool1 (if Y then HBool2'(False) else HBool2'(True));
+ end P2;
+
+ procedure P3 is
+ begin
+ X := (if Y then HBool1'(False) else HBool1'(True));
+ end P3;
+
+ procedure Q1 is
+ begin
+ Y := HBool2 (not X);
+ end Q1;
+
+ procedure Q2 is
+ begin
+ Y := HBool2 (if X then HBool1'(False) else HBool1'(True));
+ end Q2;
+
+ procedure Q3 is
+ begin
+ Y := (if X then HBool2'(False) else HBool2'(True));
+ end Q3;
+
+end Hardbool;
+
+-- One for each type's _rep_to_pos function.
+-- { dg-final { scan-tree-dump-times "gnat_rcheck_CE_Invalid_Data
..hardbool.ads" 2 "optimized" } }
+
+-- One check for each variable used in T, one use in each P* and in each Q*.
+-- { dg-final { scan-tree-dump-times "gnat_rcheck_CE_Invalid_Data
..hardbool.adb" 8 "optimized" } }
diff --git a/gcc/testsuite/gnat.dg/hardbool.ads
b/gcc/testsuite/gnat.dg/hardbool.ads
new file mode 100644
index 0000000000000..7181220a6db5d
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/hardbool.ads
@@ -0,0 +1,22 @@
+package Hardbool is
+ type HBool1 is new Boolean;
+ for HBool1'Size use 8;
+ for HBool1 use (16#5a#, 16#a5#);
+ pragma Machine_Attribute (HBool1, "hardbool");
+
+ type HBool2 is new Boolean;
+ for HBool2 use (16#0ff0#, 16#f00f#);
+ for HBool2'Size use 16;
+ pragma Machine_Attribute (HBool2, "hardbool");
+
+ X : HBool1 := False;
+ Y : HBool2 := True;
+
+ function T return Boolean;
+ procedure P1;
+ procedure P2;
+ procedure P3;
+ procedure Q1;
+ procedure Q2;
+ procedure Q3;
+end Hardbool;
--
Alexandre Oliva, happy hacker https://FSFLA.org/blogs/lxo/
Free Software Activist GNU Toolchain Engineer
Disinformation flourishes because many people care deeply about injustice
but very few check the facts. Ask me about <https://stallmansupport.org>
