From c944345b5d210e9f003bd1088f0087b9a22068c0 Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Tue, 12 May 2015 12:42:48 +0000 Subject: [PATCH] sem_intr.adb: (Check_Shift): Diagnose bad modulus value. 2015-05-12 Robert Dewar * sem_intr.adb: (Check_Shift): Diagnose bad modulus value. 2015-05-12 Robert Dewar * 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 --- gcc/ada/ChangeLog | 12 ++++++++++++ gcc/ada/gnat1drv.adb | 8 ++++++++ gcc/ada/sem_ch13.adb | 8 ++++++-- gcc/ada/sem_intr.adb | 18 ++++++++++++++++-- 4 files changed, 42 insertions(+), 4 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2912051a489..d97ba6804c7 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2015-05-12 Robert Dewar + + * sem_intr.adb: (Check_Shift): Diagnose bad modulus value. + +2015-05-12 Robert Dewar + + * 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 * g-sercom.ads, g-sercom-linux.adb (GNAT.Serial_Communications. diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 83979d7d058..9a11a527592 100644 --- 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 8e4eb0be93e..7f1f1103617 100644 --- 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 f61b47aed94..79f633a14ba 100644 --- 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); -- 2.30.2