[COMMITTED,06/30] ada: Reject too-strict alignment specifications.

Message ID 20240520074858.222435-6-poulhies@adacore.com
State Committed
Commit caaf20e2678117861a7a4d1da712be91a94596b1
Headers
Series [COMMITTED,01/30] ada: Rework and augment documentation on strict aliasing |

Commit Message

Marc Poulhiès May 20, 2024, 7:48 a.m. UTC
  From: Steve Baird <baird@adacore.com>

For a discrete (or fixed-point) type T, GNAT requires that T'Object_Size
shall be a multiple of T'Alignment * 8 .
GNAT also requires that T'Object_Size shall be no larger than
Standard'Max_Integer_Size.
For a sufficiently-large alignment specification, these requirements can
conflict.
The conflict is resolved by rejecting such alignment specifications (which
were previously accepted in some cases).

gcc/ada/

	* freeze.adb (Adjust_Esize_For_Alignment): Assert that a valid
	Alignment specification cannot result in adjusting the given
	type's Esize to be larger than System_Max_Integer_Size.
	* sem_ch13.adb (Analyze_Attribute_Definition_Clause): In analyzing
	an Alignment specification, enforce the rule that a specified
	Alignment value for a discrete or fixed-point type shall not be
	larger than System_Max_Integer_Size / 8 .

gcc/testsuite/ChangeLog:

	* gnat.dg/specs/alignment2.ads: Adjust.
	* gnat.dg/specs/alignment2_bis.ads: New test.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/freeze.adb                            |  8 +++--
 gcc/ada/sem_ch13.adb                          | 15 ++++++++
 gcc/testsuite/gnat.dg/specs/alignment2.ads    | 14 --------
 .../gnat.dg/specs/alignment2_bis.ads          | 36 +++++++++++++++++++
 4 files changed, 57 insertions(+), 16 deletions(-)
 create mode 100644 gcc/testsuite/gnat.dg/specs/alignment2_bis.ads
  

Patch

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index a980c7e5b47..26e9d01d8b2 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -303,8 +303,12 @@  package body Freeze is
       if Known_Esize (Typ) and then Known_Alignment (Typ) then
          Align := Alignment_In_Bits (Typ);
 
-         if Align > Esize (Typ) and then Align <= System_Max_Integer_Size then
-            Set_Esize (Typ, Align);
+         if Align > Esize (Typ) then
+            if Align > System_Max_Integer_Size then
+               pragma Assert (Serious_Errors_Detected > 0);
+            else
+               Set_Esize (Typ, Align);
+            end if;
          end if;
       end if;
    end Adjust_Esize_For_Alignment;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 13bf93ca548..59c80022c20 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -6573,6 +6573,21 @@  package body Sem_Ch13 is
                     ("alignment for & set to Maximum_Aligment??", Nam);
                   Set_Alignment (U_Ent, Max_Align);
 
+               --  Because Object_Size must be multiple of Alignment (in bits),
+               --  System_Max_Integer_Size limit for discrete and fixed point
+               --  types implies a limit on alignment for such types.
+
+               elsif (Is_Discrete_Type (U_Ent)
+                        or else Is_Fixed_Point_Type (U_Ent))
+                 and then Align > System_Max_Integer_Size / System_Storage_Unit
+               then
+                  Error_Msg_N
+                    ("specified alignment too large for discrete or fixed " &
+                     "point type", Expr);
+                  Set_Alignment
+                    (U_Ent, UI_From_Int (System_Max_Integer_Size /
+                                         System_Storage_Unit));
+
                --  All other cases
 
                else
diff --git a/gcc/testsuite/gnat.dg/specs/alignment2.ads b/gcc/testsuite/gnat.dg/specs/alignment2.ads
index 0b6c14f1b7d..75a002e9bee 100644
--- a/gcc/testsuite/gnat.dg/specs/alignment2.ads
+++ b/gcc/testsuite/gnat.dg/specs/alignment2.ads
@@ -32,18 +32,4 @@  package Alignment2 is
   end record;
   for R4'Alignment use 32;
 
-  -- warning
-  type I1 is new Integer_32;
-  for I1'Size use 32;
-  for I1'Alignment use 32; -- { dg-warning "suspiciously large alignment" }
-
-  -- warning
-  type I2 is new Integer_32;
-  for I2'Alignment use 32; -- { dg-warning "suspiciously large alignment" }
-
-  -- OK, big size
-  type I3 is new Integer_32;
-  for I3'Size use 32 * 8; -- { dg-warning "unused" }
-  for I3'Alignment use 32;
-
 end Alignment2;
diff --git a/gcc/testsuite/gnat.dg/specs/alignment2_bis.ads b/gcc/testsuite/gnat.dg/specs/alignment2_bis.ads
new file mode 100644
index 00000000000..ad31a400b84
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/alignment2_bis.ads
@@ -0,0 +1,36 @@ 
+-- { dg-do compile }
+
+with Interfaces; use Interfaces;
+
+package Alignment2_Bis is
+
+  pragma Warnings (Off, "*size*");
+
+  -- OK, big size
+  type R3 is record
+    A, B, C, D : Integer_8;
+  end record;
+  for R3'Size use 32 * 8;
+  for R3'Alignment use 32;
+
+  -- OK, big size
+  type R4 is record
+    A, B, C, D, E, F, G, H : Integer_32;
+  end record;
+  for R4'Alignment use 32;
+
+  -- warning
+  type I1 is new Integer_32;
+  for I1'Size use 32;
+  for I1'Alignment use 32; -- { dg-error "error: specified alignment too large for discrete or fixed point type" }
+
+  -- warning
+  type I2 is new Integer_32;
+  for I2'Alignment use 32; -- { dg-error "error: specified alignment too large for discrete or fixed point type" }
+
+  -- OK, big size
+  type I3 is new Integer_32;
+  for I3'Size use 32 * 8;
+  for I3'Alignment use 32; -- { dg-error "error: specified alignment too large for discrete or fixed point type" }
+
+end Alignment2_Bis;