[Ada] AI12-0411: Add "bool" to Interfaces.C

Message ID 20210506075812.GA125695@adacore.com
State New
Headers show
Series
  • [Ada] AI12-0411: Add "bool" to Interfaces.C
Related show

Commit Message

Pierre-Marie de Rodat May 6, 2021, 7:58 a.m.
This AI adds in Interfaces.C a binding to the C type _Bool/bool.  Note
that this AI makes ambiguous the construct pragma Assert (False) when
using Interfaces.C. To hopefully provide slightly better backward
compatibility, we make Interfaces.C.Extensions.bool a renaming of
Interfaces.C.bool so that the two types are compatible.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* libgnat/i-c.ads (bool): New type.
	* libgnat/i-cexten.ads, libgnat/i-cexten__128.ads (bool): Now
	a subtype of Interfaces.C.bool.
	* libgnarl/s-interr__vxworks.adb (Interrupt_Manager): Qualify
	False.
	* libgnarl/s-interr.adb, libgnarl/s-interr__hwint.adb,
	libgnarl/s-tasini.adb, libgnarl/s-tasren.adb,
	libgnarl/s-tassta.adb, libgnarl/s-tpobmu.adb,
	libgnarl/s-tpobop.adb, libgnarl/s-tpopmo.adb: Replace
	Assert (False) by Assert (Standard.False).

Patch

diff --git a/gcc/ada/libgnarl/s-interr.adb b/gcc/ada/libgnarl/s-interr.adb
--- a/gcc/ada/libgnarl/s-interr.adb
+++ b/gcc/ada/libgnarl/s-interr.adb
@@ -783,7 +783,7 @@  package body System.Interrupts is
                   null;
 
                when others =>
-                  pragma Assert (False);
+                  pragma Assert (Standard.False);
                   null;
             end case;
 
@@ -1228,7 +1228,7 @@  package body System.Interrupts is
             when X : others =>
                System.IO.Put_Line ("Exception in Interrupt_Manager");
                System.IO.Put_Line (Ada.Exceptions.Exception_Information (X));
-               pragma Assert (False);
+               pragma Assert (Standard.False);
          end;
       end loop;
    end Interrupt_Manager;


diff --git a/gcc/ada/libgnarl/s-interr__hwint.adb b/gcc/ada/libgnarl/s-interr__hwint.adb
--- a/gcc/ada/libgnarl/s-interr__hwint.adb
+++ b/gcc/ada/libgnarl/s-interr__hwint.adb
@@ -1023,7 +1023,7 @@  package body System.Interrupts is
                null;
 
             when others =>
-               pragma Assert (False);
+               pragma Assert (Standard.False);
                null;
          end;
       end loop;


diff --git a/gcc/ada/libgnarl/s-interr__vxworks.adb b/gcc/ada/libgnarl/s-interr__vxworks.adb
--- a/gcc/ada/libgnarl/s-interr__vxworks.adb
+++ b/gcc/ada/libgnarl/s-interr__vxworks.adb
@@ -1040,7 +1040,7 @@  package body System.Interrupts is
                null;
 
             when others =>
-               pragma Assert (False);
+               pragma Assert (Standard.False);
                null;
          end;
       end loop;


diff --git a/gcc/ada/libgnarl/s-tasini.adb b/gcc/ada/libgnarl/s-tasini.adb
--- a/gcc/ada/libgnarl/s-tasini.adb
+++ b/gcc/ada/libgnarl/s-tasini.adb
@@ -420,7 +420,7 @@  package body System.Tasking.Initialization is
             when Terminated
                | Unactivated
             =>
-               pragma Assert (False);
+               pragma Assert (Standard.False);
                null;
 
             when Activating
@@ -535,7 +535,7 @@  package body System.Tasking.Initialization is
          C := C.Common.All_Tasks_Link;
       end loop;
 
-      pragma Assert (False);
+      pragma Assert (Standard.False);
    end Remove_From_All_Tasks_List;
 
    ---------------


diff --git a/gcc/ada/libgnarl/s-tasren.adb b/gcc/ada/libgnarl/s-tasren.adb
--- a/gcc/ada/libgnarl/s-tasren.adb
+++ b/gcc/ada/libgnarl/s-tasren.adb
@@ -165,7 +165,7 @@  package body System.Tasking.Rendezvous is
 
          --  Should never get here ???
 
-         pragma Assert (False);
+         pragma Assert (Standard.False);
          raise Standard'Abort_Signal;
       end if;
 
@@ -236,7 +236,7 @@  package body System.Tasking.Rendezvous is
 
          --  Should never get here ???
 
-         pragma Assert (False);
+         pragma Assert (Standard.False);
          raise Standard'Abort_Signal;
       end if;
 
@@ -646,7 +646,7 @@  package body System.Tasking.Rendezvous is
 
          --  Should never get here ???
 
-         pragma Assert (False);
+         pragma Assert (Standard.False);
          raise Standard'Abort_Signal;
       end if;
 
@@ -1251,7 +1251,7 @@  package body System.Tasking.Rendezvous is
 
          --  Should never get here ???
 
-         pragma Assert (False);
+         pragma Assert (Standard.False);
          raise Standard'Abort_Signal;
       end if;
 
@@ -1400,7 +1400,7 @@  package body System.Tasking.Rendezvous is
 
             --  Should never get here
 
-            pragma Assert (False);
+            pragma Assert (Standard.False);
             null;
       end case;
 


diff --git a/gcc/ada/libgnarl/s-tassta.adb b/gcc/ada/libgnarl/s-tassta.adb
--- a/gcc/ada/libgnarl/s-tassta.adb
+++ b/gcc/ada/libgnarl/s-tassta.adb
@@ -578,7 +578,7 @@  package body System.Tasking.Stages is
 
          --  ??? Should never get here
 
-         pragma Assert (False);
+         pragma Assert (Standard.False);
          raise Standard'Abort_Signal;
       end if;
 


diff --git a/gcc/ada/libgnarl/s-tpobmu.adb b/gcc/ada/libgnarl/s-tpobmu.adb
--- a/gcc/ada/libgnarl/s-tpobmu.adb
+++ b/gcc/ada/libgnarl/s-tpobmu.adb
@@ -38,7 +38,7 @@  package body System.Tasking.Protected_Objects.Multiprocessors is
    procedure Served (Entry_Call : Entry_Call_Link) is
       pragma Unreferenced (Entry_Call);
    begin
-      pragma Assert (False, "Invalid operation");
+      pragma Assert (Standard.False, "Invalid operation");
    end Served;
 
    -------------------------
@@ -47,7 +47,7 @@  package body System.Tasking.Protected_Objects.Multiprocessors is
 
    procedure Wakeup_Served_Entry is
    begin
-      pragma Assert (False, "Invalid operation");
+      pragma Assert (Standard.False, "Invalid operation");
    end Wakeup_Served_Entry;
 
 end System.Tasking.Protected_Objects.Multiprocessors;


diff --git a/gcc/ada/libgnarl/s-tpobop.adb b/gcc/ada/libgnarl/s-tpobop.adb
--- a/gcc/ada/libgnarl/s-tpobop.adb
+++ b/gcc/ada/libgnarl/s-tpobop.adb
@@ -601,7 +601,7 @@  package body System.Tasking.Protected_Objects.Operations is
             when Asynchronous_Call
                | Timed_Call
             =>
-               pragma Assert (False);
+               pragma Assert (Standard.False);
                null;
          end case;
       end if;


diff --git a/gcc/ada/libgnarl/s-tpopmo.adb b/gcc/ada/libgnarl/s-tpopmo.adb
--- a/gcc/ada/libgnarl/s-tpopmo.adb
+++ b/gcc/ada/libgnarl/s-tpopmo.adb
@@ -208,7 +208,7 @@  package body Monotonic is
                      exit Inner;
 
                   when others =>
-                     pragma Assert (False);
+                     pragma Assert (Standard.False);
 
                end case;
 
@@ -292,7 +292,7 @@  package body Monotonic is
                   when 0 | EINTR => null;
 
                   when others =>
-                     pragma Assert (False);
+                     pragma Assert (Standard.False);
 
                end case;
 


diff --git a/gcc/ada/libgnat/i-c.ads b/gcc/ada/libgnat/i-c.ads
--- a/gcc/ada/libgnat/i-c.ads
+++ b/gcc/ada/libgnat/i-c.ads
@@ -61,6 +61,11 @@  package Interfaces.C is
 
    type size_t is mod 2 ** System.Parameters.ptr_bits;
 
+   --  Boolean type
+
+   type bool is new Boolean;
+   pragma Convention (C, bool);
+
    --  Floating-Point
 
    type C_float     is new Float;


diff --git a/gcc/ada/libgnat/i-cexten.ads b/gcc/ada/libgnat/i-cexten.ads
--- a/gcc/ada/libgnat/i-cexten.ads
+++ b/gcc/ada/libgnat/i-cexten.ads
@@ -56,8 +56,7 @@  package Interfaces.C.Extensions is
 
    --  C bool
 
-   type bool is new Boolean;
-   pragma Convention (C, bool);
+   subtype bool is Interfaces.C.bool;
 
    --  64-bit integer types
 


diff --git a/gcc/ada/libgnat/i-cexten__128.ads b/gcc/ada/libgnat/i-cexten__128.ads
--- a/gcc/ada/libgnat/i-cexten__128.ads
+++ b/gcc/ada/libgnat/i-cexten__128.ads
@@ -56,8 +56,7 @@  package Interfaces.C.Extensions is
 
    --  C bool
 
-   type bool is new Boolean;
-   pragma Convention (C, bool);
+   subtype bool is Interfaces.C.bool;
 
    --  64-bit integer types