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
This commit is contained in:
Robert Dewar 2015-05-12 12:42:48 +00:00 committed by Arnaud Charlet
parent 52ea13f2c1
commit c944345b5d
4 changed files with 42 additions and 4 deletions

View File

@ -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.

View File

@ -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).

View File

@ -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

View File

@ -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);