diff mbox

[Ada] Expression functions as completions and private types

Message ID 20170113105448.GA142925@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Jan. 13, 2017, 10:54 a.m. UTC
An expression function that is a completion is a freeze point for all
entities referenced in its expression. As a consequence, a reference
to an uncompleted private type declared in an enclosing scope is illegal.
This patch adds the proper check to enforce this rule.

Compiling env_baselines.ads must yield:

   env_baseline.ads:16:51: premature use of private type "T"

---
package Env_Baseline is
   package Side is
      type T is (First, Last);
   end Side;

   type T is private;

   package General is
      type T is private;

      function First (Set : T) return Env_Baseline.T;

   private
      type T is array (Side.T) of Env_Baseline.T;

      function First (Set : T) return Env_Baseline.T is (Set (Side.First));
   end General;

private
   type T is record
      Major : Natural;
      Minor : Natural;
   end record;
end Env_Baseline;

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

2017-01-13  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Analyze_Expression_Function): If the expression
	function is a completion, all entities referenced in the
	expression are frozen. As a consequence, a reference to an
	uncompleted private type from an enclosing scope is illegal.
diff mbox

Patch

Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb	(revision 244418)
+++ sem_ch6.adb	(working copy)
@@ -274,6 +274,7 @@ 
       New_Spec : Node_Id;
       Orig_N   : Node_Id;
       Ret      : Node_Id;
+      Ret_Type : Entity_Id;
 
       Prev : Entity_Id;
       --  If the expression is a completion, Prev is the entity whose
@@ -366,17 +367,35 @@ 
       then
          Set_Has_Completion (Prev, False);
          Set_Is_Inlined (Prev);
+         Ret_Type := Etype (Prev);
 
          --  An expression function that is a completion freezes the
-         --  expression. This means freezing the return type, and if it is
-         --  an access type, freezing its designated type as well.
+         --  expression. This means freezing the return type, and if it is an
+         --  access type, freezing its designated type as well.
 
          --  Note that we cannot defer this freezing to the analysis of the
          --  expression itself, because a freeze node might appear in a nested
          --  scope, leading to an elaboration order issue in gigi.
 
-         Freeze_Before (N, Etype (Prev));
+         --  An entity can only be frozen if it has a completion, so we must
+         --  check this explicitly. If it is declared elsewhere it will have
+         --  been frozen already, so only types declared in currently opend
+         --  scopes need to be tested.
 
+         if Ekind (Ret_Type) = E_Private_Type
+           and then In_Open_Scopes (Scope (Ret_Type))
+           and then not Is_Generic_Type (Ret_Type)
+           and then not Is_Frozen (Ret_Type)
+           and then No (Full_View (Ret_Type))
+         then
+            Error_Msg_NE
+              ("premature use of private type&",
+               Result_Definition (Specification (N)), Ret_Type);
+
+         else
+            Freeze_Before (N, Ret_Type);
+         end if;
+
          if Is_Access_Type (Etype (Prev)) then
             Freeze_Before (N, Designated_Type (Etype (Prev)));
          end if;