From: Alexandre Oliva <oliva@adacore.com>
Date: Fri, 13 May 2022 10:48:49 +0000 (-0300)
Subject: Introduce tests for hardbool Machine_Attribute for Ada
X-Git-Tag: basepoints/gcc-14~6789
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=9a79854be0a81faf76fff073f447c2334d47e819;p=thirdparty%2Fgcc.git

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.
---

diff --git a/gcc/testsuite/gnat.dg/hardbool.adb b/gcc/testsuite/gnat.dg/hardbool.adb
new file mode 100644
index 00000000000..cc38af06a79
--- /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 00000000000..7181220a6db
--- /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;