[Ada] Warnings on non-static components of protected types

[Arnaud Charlet]

This patch improves the warnings on component of protected types when compiled
under restriction No_Heap_allocations. The patch distinguishes betwen:

a)  components whose size depends on discriminants, in which case an object of
the type will not violate restriction if the discriminants have static values.

b) Components whose size depends on some other non-static expression, e.g. a
function call, in which case any object of the type will violate restriction.

Compiling toto.adb must yield:

   toto.ads:5:07: warning: creation of protected object of type "Bounded_Queue"
     with non-static discriminants  will violate restriction
       No_Implicit_Heap_Allocations

---
pragma restrictions (No_Implicit_Heap_Allocations);
package toto is
   protected type Bounded_Queue (c : integer) is
   private
      Queue_Elements : String (1 .. C);
   end Bounded_Queue;
end;
---
package body toto is
   protected body  Bounded_Queue is
--   begin
--      null;
   end Bounded_Queue;

   A : Bounded_queue (3);
begin
   null;
end;

Tested on x86_64-pc-linux-gnu, committed on trunk

2014-07-31  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch9.adb (Expand_N_Protected_Type_Declaration): New
	predicate Discriminated_Size, to distinguish between private
	components that depend on discriminants from those whose size
	depends on some other non-static expression.

-------------- next part --------------
Index: exp_ch9.adb
===================================================================
--- exp_ch9.adb	(revision 213325)
+++ exp_ch9.adb	(working copy)
@@ -8877,6 +8877,12 @@
       --  to the internal body, for possible inlining later on. The source
       --  operation is invisible to the back-end and is never actually called.
 
+      function Discriminated_Size (Comp : Entity_Id) return Boolean;
+      --  If a component size is not static then a warning will be emitted
+      --  in Ravenscar or other restricted contexts. When a component is non-
+      --  static because of a discriminant constraint we can specialize the
+      --  warning by mentioning discriminants explicitly.
+
       procedure Expand_Entry_Declaration (Comp : Entity_Id);
       --  Create the subprograms for the barrier and for the body, and append
       --  then to Entry_Bodies_Array.
@@ -8904,10 +8910,66 @@
          end if;
       end Check_Inlining;
 
-      ---------------------------------
-      -- Check_Static_Component_Size --
-      ---------------------------------
+      ------------------------
+      -- Discriminated_Size --
+      ------------------------
 
+      function Discriminated_Size (Comp : Entity_Id) return Boolean
+      is
+         Typ   : constant Entity_Id := Etype (Comp);
+         Index : Node_Id;
+
+         function Non_Static_Bound (Bound : Node_Id) return Boolean;
+         --  Check whether the bound of an index is non-static and does
+         --  denote a discriminant, in which case any protected object of
+         --  the type will have a non-static size.
+
+         ----------------------
+         -- Non_Static_Bound --
+         ----------------------
+
+         function Non_Static_Bound (Bound : Node_Id) return Boolean is
+         begin
+            if Is_Static_Expression (Bound) then
+               return False;
+
+            elsif Is_Entity_Name (Bound)
+               and then Present (Discriminal_Link (Entity (Bound)))
+            then
+               return False;
+
+            else
+               return True;
+            end if;
+         end Non_Static_Bound;
+
+      begin
+         if not Is_Array_Type (Typ) then
+            return False;
+         end if;
+
+         if Ekind (Typ) = E_Array_Subtype then
+            Index := First_Index (Typ);
+            while Present (Index) loop
+               if Non_Static_Bound (Low_Bound (Index))
+                 or else Non_Static_Bound (High_Bound (Index))
+               then
+                  return False;
+               end if;
+
+               Next_Index (Index);
+            end loop;
+
+            return True;
+         end if;
+
+         return False;
+      end Discriminated_Size;
+
+      ---------------------------
+      -- Static_Component_Size --
+      ---------------------------
+
       function Static_Component_Size (Comp : Entity_Id) return Boolean is
          Typ : constant Entity_Id := Etype (Comp);
          C   : Entity_Id;
@@ -9100,11 +9162,26 @@
                      Check_Restriction (No_Implicit_Heap_Allocations, Priv);
 
                   elsif Restriction_Active (No_Implicit_Heap_Allocations) then
-                     Error_Msg_N ("component has non-static size??", Priv);
-                     Error_Msg_NE
-                       ("\creation of protected object of type& will violate"
-                        & " restriction No_Implicit_Heap_Allocations??",
-                        Priv, Prot_Typ);
+                     if not Discriminated_Size (Defining_Identifier (Priv))
+                     then
+
+                        --  Any object of the type will be  non-static.
+
+                        Error_Msg_N ("component has non-static size??", Priv);
+                        Error_Msg_NE
+                          ("\creation of protected object of type& will"
+                           & " violate restriction "
+                           & "No_Implicit_Heap_Allocations??", Priv, Prot_Typ);
+                     else
+
+                        --  Object will be non-static if discriminants are.
+
+                        Error_Msg_NE
+                          ("creation of protected object of type& with "
+                           &  "non-static discriminants  will violate"
+                           & " restriction No_Implicit_Heap_Allocations??",
+                           Priv, Prot_Typ);
+                     end if;
                   end if;
                end if;