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.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* doc/gnat_rm/security_hardening_features.rst (Hardened
Booleans): New.
* exp_util.adb (Adjust_Condition): Perform validity checking on
hardbool-annotated types even with -gnatVT.
* gnat_rm.texi: Regenerate.
* gcc-interface/utils.cc (gnat_internal_attribute_table): Ignore
hardbool.diff --git a/gcc/ada/doc/gnat_rm/security_hardening_features.rst b/gcc/ada/doc/gnat_rm/security_hardening_features.rst
--- a/gcc/ada/doc/gnat_rm/security_hardening_features.rst
+++ b/gcc/ada/doc/gnat_rm/security_hardening_features.rst
@@ -160,3 +160,39 @@ files of the corresponding passes, through command line options
They are separate options, however, because of the significantly
different performance impact of the hardening transformations.
+
+
+.. Hardened Booleans:
+
+Hardened Booleans
+=
+
+Ada has built-in support for introducing boolean types with
+alternative representations, using representation clauses:
+
+.. code-block:: ada
+
+ type HBool is new Boolean;
+ for HBool use (16#5a#, 16#a5#);
+ for HBool'Size use 8;
+
+When validity checking is enabled, the compiler will check that
+variables of such types hold values corresponding to the selected
+representations.
+
+There are multiple strategies for where to introduce validity checking
+(see *-gnatV* options). Their goal is to guard against various kinds
+of programming errors, and GNAT strives to omit checks when program
+logic rules out an invalid value, and optimizers may further remove
+checks found to be redundant.
+
+For additional hardening, the ``hardbool`` :samp:`Machine_Attribute`
+pragma can be used to annotate boolean types with representation
+clauses, so that expressions of such types used as conditions are
+checked even when compiling with *-gnatVT*.
+
+.. code-block:: ada
+
+ pragma Machine_Attribute (HBool, "hardbool");
+
+Note that *-gnatVn* will disable even ``hardbool`` testing.
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -328,6 +328,72 @@ package body Exp_Util is
--
procedure Adjust_Condition (N : Node_Id) is
+
+ function Is_Hardbool_Type (T : Entity_Id) return Boolean;
+ -- Return True iff T is a type annotated with the
+ -- Machine_Attribute pragma "hardbool".
+
+ --
+ -- Is_Hardbool_Type --
+ --
+
+ function Is_Hardbool_Type (T : Entity_Id) return Boolean is
+
+ function Find_Hardbool_Pragma
+ (Id : Entity_Id) return Node_Id;
+ -- Return a Rep_Item associated with entity Id that
+ -- corresponds to the Hardbool Machine_Attribute pragma, if
+ -- any, or Empty otherwise.
+
+ function Pragma_Arg_To_String (Item : Node_Id) return String is
+(To_String (Strval (Expr_Value_S (Item;
+ -- Return the pragma argument Item as a String
+
+ function Hardbool_Pragma_P (Item : Node_Id) return Boolean is
+(Nkind (Item) = N_Pragma
+ and then
+ Pragma_Name (Item) = Name_Machine_Attribute
+ and then
+ Pragma_Arg_To_String
+ (Get_Pragma_Arg
+ (Next (First (Pragma_Argument_Associations (Item)
+ = "hardbool");
+ -- Return True iff representation Item is a "hardbool"
+ -- Machine_Attribute pragma.
+
+ --
+ -- Find_Hardbool_Pragma --
+ --
+
+ function Find_Hardbool_Pragma
+ (Id : Entity_Id) return Node_Id
+ is
+Item : Node_Id;
+
+ begin
+if not Has_Gigi_Rep_Item (Id) then
+ return Empty;
+end if;
+
+Item := First_Rep_Item (Id);
+while Present (Item) loop
+ if Hardbool_Pragma_P (Item) then
+ return Item;
+ end if;
+ Item := Next_Rep_Item (Item);
+end loop;
+
+return Empty;
+ end Find_Hardbool_Pragma;
+
+ -- Start of processing for Is_Hardbool_Type
+
+ begin
+ return Present (Find_Hardbool_Pragma (T));
+ end Is_Hardbool_Type;
+
+ -- Start of processing for Adjust_Condition
+
begin
if No (N) then
return;
@@ -347,7 +413,10 @@ package body Exp_Util is
-- Apply validity checking if needed
- if Validity_Checks_On and Validity_Check_Tests then
+ if Validity_Checks_On
+ and then
+ (Validity_Check_Tests or else Is_Hardbool_Type (T))
+ then
