sem_intr.adb: (Check_Shift): Diagnose bad modulus value.

2015-05-12  Robert Dewar  <dewar@adacore.com>

	* sem_intr.adb: (Check_Shift): Diagnose bad modulus value.

2015-05-12  Robert Dewar  <dewar@adacore.com>

	* gnat1drv.adb (Adjust_Global_Switches): Default to suppressing
	Alignment_Checks on non-strict alignment machine.
	* sem_ch13.adb (Validate_Address_Clauses): Don't give
	compile-time alignment warnings if run time Alignment_Check
	is suppressed.

From-SVN: r223063

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2912051a489d24c6d30cd5e0317724275b52cd03..d97ba6804c79b5fb7098d7d56b7b91add598e055 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,15 @@
+2015-05-12  Robert Dewar  <dewar@adacore.com>
+
+       * sem_intr.adb: (Check_Shift): Diagnose bad modulus value.
+
+2015-05-12  Robert Dewar  <dewar@adacore.com>
+
+       * gnat1drv.adb (Adjust_Global_Switches): Default to suppressing
+       Alignment_Checks on non-strict alignment machine.
+       * sem_ch13.adb (Validate_Address_Clauses): Don't give
+       compile-time alignment warnings if run time Alignment_Check
+       is suppressed.
+
 2015-05-12  Thomas Quinot  <quinot@adacore.com>
 
        * g-sercom.ads, g-sercom-linux.adb (GNAT.Serial_Communications.

diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index 83979d7d058684949a4a15449ff58d9d9b7f8973..9a11a52759256552bc8839194041f4a797e23bdd 100644 (file)
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -565,6 +565,14 @@ procedure Gnat1drv is
       Suppress_Options.Suppress (Atomic_Synchronization) :=
         not Atomic_Sync_Default_On_Target;
 
+      --  Set default for Alignment_Check, if we are on a machine with non-
+      --  strict alignment, then we suppress this check, since it is over-
+      --  zealous for such machines.
+
+      if not Ttypes.Target_Strict_Alignment then
+         Suppress_Options.Suppress (Alignment_Check) := True;
+      end if;
+
       --  Set switch indicating if back end can handle limited types, and
       --  guarantee that no incorrect copies are made (e.g. in the context
       --  of an if or case expression).

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 8e4eb0be93ed1431ecb5850b4a45f502be485d6e..7f1f11036172807c0996ea14909c8c8759797c99 100644 (file)
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -12646,12 +12646,16 @@ package body Sem_Ch13 is
                     ("\??size of & is ^", ACCR.N, ACCR.Y);
 
                --  Check for inadequate alignment, both of the base object
-               --  and of the offset, if any.
+               --  and of the offset, if any. We only do this check if the
+               --  run-time Alignment_Check is active. No point in warning
+               --  if this check has been suppressed (or is suppressed by
+               --  default in the non-strict alignment machine case).
 
                --  Note: we do not check the alignment if we gave a size
                --  warning, since it would likely be redundant.
 
-               elsif Y_Alignment /= Uint_0
+               elsif not Alignment_Checks_Suppressed (ACCR.Y)
+                 and then Y_Alignment /= Uint_0
                  and then (Y_Alignment < X_Alignment
                              or else (ACCR.Off
                                         and then

diff --git a/gcc/ada/sem_intr.adb b/gcc/ada/sem_intr.adb
index f61b47aed94e1a272e56c2bfcaf499e4c5aa2bfe..79f633a14ba15c8d9f66d201af10d6719974edd6 100644 (file)
--- a/gcc/ada/sem_intr.adb
+++ b/gcc/ada/sem_intr.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -430,13 +430,27 @@ package body Sem_Intr is
       then
          Errint
            ("first argument for shift must have size 8, 16, 32 or 64",
-             Ptyp1, N);
+            Ptyp1, N);
          return;
 
       elsif Non_Binary_Modulus (Typ1) then
          Errint
            ("shifts not allowed for non-binary modular types", Ptyp1, N);
 
+      --  For modular type, modulus must be 2**8, 2**16, 2**32, or 2**64.
+      --  Don't apply to generic types, since we may not have a modulus value.
+
+      elsif Is_Modular_Integer_Type (Typ1)
+        and then not Is_Generic_Type (Typ1)
+        and then Modulus (Typ1) /= Uint_2 ** 8
+        and then Modulus (Typ1) /= Uint_2 ** 16
+        and then Modulus (Typ1) /= Uint_2 ** 32
+        and then Modulus (Typ1) /= Uint_2 ** 64
+      then
+         Errint
+           ("modular type for shift must have modulus of 2'*'*8, "
+            & "2'*'*16, 2'*'*32, or 2'*'*64", Ptyp1, N);
+
       elsif Etype (Arg1) /= Etype (E) then
          Errint
            ("first argument of shift must match return type", Ptyp1, N);