[Ada] Fix overflow with entry queue

[Ada] Fix overflow with entry queue

[Eric Botcazou]

[-- Attachment #1: Type: text/plain, Size: 787 bytes --]

This is a regression present on the mainline and 4.9 branch: declaring an 
array of entries of a protected object results in an size overflow for the 
array.  There is a known overflow issue with entry families for protected 
objects, which is papered over in the FE (see the top of Exp_Ch9), but the 
trick has been silently disabled.

Tested on x86_64-suse-linux, applied on mainline and 4.9 branch.


2014-10-27  Eric Botcazou  <ebotcazou@adacore.com>

	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Array_Type>: Remove
	superfluous computation for the max size.
	<E_Array_Subtype>: Likewise.  Make sure that the max size calculation
	does not overflow at compile time.


2014-10-27  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat.dg/entry_queues2.adb: New test.


-- 
Eric Botcazou

[-- Attachment #2: p.diff --]
[-- Type: text/x-patch, Size: 1874 bytes --]

Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c	(revision 216612)
+++ gcc-interface/decl.c	(working copy)
@@ -2127,11 +2127,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
 		tree gnu_max
 		  = convert (sizetype, TYPE_MAX_VALUE (gnu_index_type));
 		tree gnu_this_max
-		  = size_binop (MAX_EXPR,
-				size_binop (PLUS_EXPR, size_one_node,
-					    size_binop (MINUS_EXPR,
-							gnu_max, gnu_min)),
-				size_zero_node);
+		  = size_binop (PLUS_EXPR, size_one_node,
+				size_binop (MINUS_EXPR, gnu_max, gnu_min));
 
 		if (TREE_CODE (gnu_this_max) == INTEGER_CST
 		    && TREE_OVERFLOW (gnu_this_max))
@@ -2464,20 +2461,26 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
 		    gnu_max_size = NULL_TREE;
 		  else
 		    {
-		      tree gnu_this_max
-			= size_binop (MAX_EXPR,
-				      size_binop (PLUS_EXPR, size_one_node,
-						  size_binop (MINUS_EXPR,
-							      gnu_base_max,
-							      gnu_base_min)),
-				      size_zero_node);
+		      tree gnu_this_max;
 
-		      if (TREE_CODE (gnu_this_max) == INTEGER_CST
-			  && TREE_OVERFLOW (gnu_this_max))
-			gnu_max_size = NULL_TREE;
+		      /* Use int_const_binop if the bounds are constant to
+			 avoid any unwanted overflow.  */
+		      if (TREE_CODE (gnu_base_min) == INTEGER_CST
+			  && TREE_CODE (gnu_base_max) == INTEGER_CST)
+			gnu_this_max
+			  = int_const_binop (PLUS_EXPR, size_one_node,
+					     int_const_binop (MINUS_EXPR,
+							      gnu_base_max,
+							      gnu_base_min));
 		      else
-			gnu_max_size
-			  = size_binop (MULT_EXPR, gnu_max_size, gnu_this_max);
+			gnu_this_max
+			  = size_binop (PLUS_EXPR, size_one_node,
+					size_binop (MINUS_EXPR,
+						    gnu_base_max,
+						    gnu_base_min));
+
+		      gnu_max_size
+			= size_binop (MULT_EXPR, gnu_max_size, gnu_this_max);
 		    }
 		}
 

[-- Attachment #3: entry_queues2.adb --]
[-- Type: text/x-adasrc, Size: 834 bytes --]

-- { dg-do compile }

procedure Entry_Queues2 is

    F1 : Integer := 17;

    generic
        type T is limited private;
    procedure Check;

    procedure Check is
    begin
        declare
            type Poe is new T;
        begin
            declare
                type Arr is array (1 .. 2) of Poe;
                X : Arr;
                pragma Unreferenced (X);
            begin
                null;
            end;
        end;
    end;

begin

    declare
        protected type Poe (D3 : Integer := F1) is
            entry E (D3 .. F1);    -- F1 evaluated
        end Poe;
        protected body Poe is
            entry E (for I in D3 .. F1) when True is
            begin
                null;
            end E;
        end Poe;

        procedure Chk is new Check (Poe);

    begin
        Chk;
    end;

end;