[Ada] Strengthen compatibility warning for GCC builtins

Message ID 1870144.PYKUYFuaPT@fomalhaut
State Committed
Commit fad540552ffa23dae2874aaf93916175d2577b8e
Headers
Series [Ada] Strengthen compatibility warning for GCC builtins |

Commit Message

Eric Botcazou Sept. 14, 2021, 9 a.m. UTC
  This is necessary for vector builtins, which are picky about the signedness of 
the element type.

Tested on x86-64/Linux, applied on the mainline.


2021-09-14  Eric Botcazou  <ebotcazou@adacore.com>

	* libgnat/s-atopri.ads (bool): Delete.
	(Atomic_Test_And_Set): Replace bool with Boolean.
	(Atomic_Always_Lock_Free): Likewise.
	* libgnat/s-aoinar.adb (Is_Lock_Free): Adjust.
	* libgnat/s-aomoar.adb (Is_Lock_Free): Likewise.
	* libgnat/s-aotase.adb (Atomic_Test_And_Set): Likewise.
	* libgnat/s-atopex.adb (Atomic_Compare_And_Exchange): Likewise.
	* gcc-interface/decl.c: Include gimple-expr.h.
	(intrin_types_incompatible_p): Delete.
	(intrin_arglists_compatible_p): Call types_compatible_p.
	(intrin_return_compatible_p): Likewise.
  

Patch

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index d37ed3d1b52..38a8bda02ce 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -28,6 +28,7 @@ 
 #include "coretypes.h"
 #include "target.h"
 #include "tree.h"
+#include "gimple-expr.h"
 #include "stringpool.h"
 #include "diagnostic-core.h"
 #include "alias.h"
@@ -9492,46 +9493,6 @@  check_ok_for_atomic_type (tree type, Entity_Id gnat_entity, bool component_p)
 		   gnat_error_point, gnat_entity);
 }
 
-
-/* Helper for the intrin compatibility checks family.  Evaluate whether
-   two types are definitely incompatible.  */
-
-static bool
-intrin_types_incompatible_p (tree t1, tree t2)
-{
-  enum tree_code code;
-
-  if (TYPE_MAIN_VARIANT (t1) == TYPE_MAIN_VARIANT (t2))
-    return false;
-
-  if (TYPE_MODE (t1) != TYPE_MODE (t2))
-    return true;
-
-  if (TREE_CODE (t1) != TREE_CODE (t2))
-    return true;
-
-  code = TREE_CODE (t1);
-
-  switch (code)
-    {
-    case INTEGER_TYPE:
-    case REAL_TYPE:
-      return TYPE_PRECISION (t1) != TYPE_PRECISION (t2);
-
-    case POINTER_TYPE:
-    case REFERENCE_TYPE:
-      /* Assume designated types are ok.  We'd need to account for char * and
-	 void * variants to do better, which could rapidly get messy and isn't
-	 clearly worth the effort.  */
-      return false;
-
-    default:
-      break;
-    }
-
-  return false;
-}
-
 /* Helper for intrin_profiles_compatible_p, to perform compatibility checks
    on the Ada/builtin argument lists for the INB binding.  */
 
@@ -9577,8 +9538,8 @@  intrin_arglists_compatible_p (intrin_binding_t * inb)
 	}
 
       /* Otherwise, check that types match for the current argument.  */
-      argpos ++;
-      if (intrin_types_incompatible_p (ada_type, btin_type))
+      argpos++;
+      if (!types_compatible_p (ada_type, btin_type))
 	{
 	  post_error_ne_num ("??intrinsic binding type mismatch on argument ^!",
 			     inb->gnat_entity, inb->gnat_entity, argpos);
@@ -9609,7 +9570,7 @@  intrin_return_compatible_p (intrin_binding_t * inb)
 
   /* Check return types compatibility otherwise.  Note that this
      handles void/void as well.  */
-  if (intrin_types_incompatible_p (btin_return_type, ada_return_type))
+  if (!types_compatible_p (btin_return_type, ada_return_type))
     {
       post_error ("??intrinsic binding type mismatch on return value!",
 		  inb->gnat_entity);
diff --git a/gcc/ada/libgnat/s-aoinar.adb b/gcc/ada/libgnat/s-aoinar.adb
index df12b16b9e5..2f430ed4efe 100644
--- a/gcc/ada/libgnat/s-aoinar.adb
+++ b/gcc/ada/libgnat/s-aoinar.adb
@@ -203,7 +203,7 @@  package body System.Atomic_Operations.Integer_Arithmetic is
       pragma Unreferenced (Item);
       use type Interfaces.C.size_t;
    begin
-      return Boolean (Atomic_Always_Lock_Free (Atomic_Type'Object_Size / 8));
+      return Atomic_Always_Lock_Free (Atomic_Type'Object_Size / 8);
    end Is_Lock_Free;
 
 end System.Atomic_Operations.Integer_Arithmetic;
diff --git a/gcc/ada/libgnat/s-aomoar.adb b/gcc/ada/libgnat/s-aomoar.adb
index c955623897d..a6f4b0e61e8 100644
--- a/gcc/ada/libgnat/s-aomoar.adb
+++ b/gcc/ada/libgnat/s-aomoar.adb
@@ -209,7 +209,7 @@  package body System.Atomic_Operations.Modular_Arithmetic is
       pragma Unreferenced (Item);
       use type Interfaces.C.size_t;
    begin
-      return Boolean (Atomic_Always_Lock_Free (Atomic_Type'Object_Size / 8));
+      return Atomic_Always_Lock_Free (Atomic_Type'Object_Size / 8);
    end Is_Lock_Free;
 
 end System.Atomic_Operations.Modular_Arithmetic;
diff --git a/gcc/ada/libgnat/s-aotase.adb b/gcc/ada/libgnat/s-aotase.adb
index 53178892621..94b28dfa410 100644
--- a/gcc/ada/libgnat/s-aotase.adb
+++ b/gcc/ada/libgnat/s-aotase.adb
@@ -40,7 +40,7 @@  package body System.Atomic_Operations.Test_And_Set is
    function Atomic_Test_And_Set
      (Item : aliased in out Test_And_Set_Flag) return Boolean is
    begin
-      return Boolean (Atomic_Test_And_Set (Item'Address));
+      return Atomic_Test_And_Set (Item'Address);
    end Atomic_Test_And_Set;
 
    ------------------
diff --git a/gcc/ada/libgnat/s-atopex.adb b/gcc/ada/libgnat/s-atopex.adb
index 501254e4f5f..b0aa9e593d1 100644
--- a/gcc/ada/libgnat/s-atopex.adb
+++ b/gcc/ada/libgnat/s-atopex.adb
@@ -89,36 +89,36 @@  package body System.Atomic_Operations.Exchange is
         (Ptr           : System.Address;
          Expected      : System.Address;
          Desired       : Atomic_Type;
-         Weak          : bool := False;
+         Weak          : Boolean := False;
          Success_Model : Mem_Model := Seq_Cst;
-         Failure_Model : Mem_Model := Seq_Cst) return bool;
+         Failure_Model : Mem_Model := Seq_Cst) return Boolean;
       pragma Import
         (Intrinsic, Atomic_Compare_Exchange_1, "__atomic_compare_exchange_1");
       function Atomic_Compare_Exchange_2
         (Ptr           : System.Address;
          Expected      : System.Address;
          Desired       : Atomic_Type;
-         Weak          : bool := False;
+         Weak          : Boolean := False;
          Success_Model : Mem_Model := Seq_Cst;
-         Failure_Model : Mem_Model := Seq_Cst) return bool;
+         Failure_Model : Mem_Model := Seq_Cst) return Boolean;
       pragma Import
         (Intrinsic, Atomic_Compare_Exchange_2, "__atomic_compare_exchange_2");
       function Atomic_Compare_Exchange_4
         (Ptr           : System.Address;
          Expected      : System.Address;
          Desired       : Atomic_Type;
-         Weak          : bool := False;
+         Weak          : Boolean := False;
          Success_Model : Mem_Model := Seq_Cst;
-         Failure_Model : Mem_Model := Seq_Cst) return bool;
+         Failure_Model : Mem_Model := Seq_Cst) return Boolean;
       pragma Import
         (Intrinsic, Atomic_Compare_Exchange_4, "__atomic_compare_exchange_4");
       function Atomic_Compare_Exchange_8
         (Ptr           : System.Address;
          Expected      : System.Address;
          Desired       : Atomic_Type;
-         Weak          : bool := False;
+         Weak          : Boolean := False;
          Success_Model : Mem_Model := Seq_Cst;
-         Failure_Model : Mem_Model := Seq_Cst) return bool;
+         Failure_Model : Mem_Model := Seq_Cst) return Boolean;
       pragma Import
         (Intrinsic, Atomic_Compare_Exchange_8, "__atomic_compare_exchange_8");
       pragma Warnings (On);
@@ -126,21 +126,17 @@  package body System.Atomic_Operations.Exchange is
    begin
       case Atomic_Type'Object_Size is
          when 8 =>
-            return Boolean
-              (Atomic_Compare_Exchange_1
-                (Item'Address, Prior'Address, Desired));
+            return
+              Atomic_Compare_Exchange_1 (Item'Address, Prior'Address, Desired);
          when 16 =>
-            return Boolean
-              (Atomic_Compare_Exchange_2
-                (Item'Address, Prior'Address, Desired));
+            return
+              Atomic_Compare_Exchange_2 (Item'Address, Prior'Address, Desired);
          when 32 =>
-            return Boolean
-              (Atomic_Compare_Exchange_4
-                (Item'Address, Prior'Address, Desired));
+            return
+              Atomic_Compare_Exchange_4 (Item'Address, Prior'Address, Desired);
          when 64 =>
-            return Boolean
-              (Atomic_Compare_Exchange_8
-                (Item'Address, Prior'Address, Desired));
+            return
+              Atomic_Compare_Exchange_8 (Item'Address, Prior'Address, Desired);
          when others =>
             raise Program_Error;
       end case;
@@ -154,7 +150,7 @@  package body System.Atomic_Operations.Exchange is
       pragma Unreferenced (Item);
       use type Interfaces.C.size_t;
    begin
-      return Boolean (Atomic_Always_Lock_Free (Atomic_Type'Object_Size / 8));
+      return Atomic_Always_Lock_Free (Atomic_Type'Object_Size / 8);
    end Is_Lock_Free;
 
 end System.Atomic_Operations.Exchange;
diff --git a/gcc/ada/libgnat/s-atopri.ads b/gcc/ada/libgnat/s-atopri.ads
index 2a5ffe59803..891b2edf061 100644
--- a/gcc/ada/libgnat/s-atopri.ads
+++ b/gcc/ada/libgnat/s-atopri.ads
@@ -62,9 +62,6 @@  package System.Atomic_Primitives is
 
    subtype Mem_Model is Integer range Relaxed .. Last;
 
-   type bool is new Boolean;
-   pragma Convention (C, bool);
-
    ------------------------------------
    -- GCC built-in atomic primitives --
    ------------------------------------
@@ -137,7 +134,7 @@  package System.Atomic_Primitives is
 
    function Atomic_Test_And_Set
      (Ptr   : System.Address;
-      Model : Mem_Model := Seq_Cst) return bool;
+      Model : Mem_Model := Seq_Cst) return Boolean;
    pragma Import (Intrinsic, Atomic_Test_And_Set, "__atomic_test_and_set");
 
    procedure Atomic_Clear
@@ -147,7 +144,7 @@  package System.Atomic_Primitives is
 
    function Atomic_Always_Lock_Free
      (Size : Interfaces.C.size_t;
-      Ptr  : System.Address := System.Null_Address) return bool;
+      Ptr  : System.Address := System.Null_Address) return Boolean;
    pragma Import
      (Intrinsic, Atomic_Always_Lock_Free, "__atomic_always_lock_free");