This patch adds checks on the expressions of pre/postconditions for task and
protected entries, prior to their full analysis, so that errors are properly
emitted in various compiler modes.

Tested by ACATS 4.0L: B611008

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

2016-06-16  Ed Schonberg  <schonb...@adacore.com>

        * sem_ch3.adb (Check_Entry_Contracts): New procedure, subsidiary
        of Analyze_Declarations, that performs pre-analysis of
        pre/postconditions on entry declarations before full analysis
        is performed after entries have been converted into procedures.
        Done solely to capture semantic errors.
        * sem_attr.adb (Analyze_Attribute, case 'Result): Add guard to
        call to Denote_Same_Function.

Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb (revision 237514)
+++ sem_ch3.adb (working copy)
@@ -2165,6 +2165,13 @@
       --  (They have the sloc of the label as found in the source, and that
       --  is ahead of the current declarative part).
 
+      procedure Check_Entry_Contracts;
+      --  Perform a pre-analysis of the pre- and postconditions of an entry
+      --  declaration. This must be done before full resolution and creation
+      --  of the parameter block, etc. to catch illegal uses within the
+      --  contract expression. Full analysis of the expression is done when
+      --  the contract is processed.
+
       procedure Handle_Late_Controlled_Primitive (Body_Decl : Node_Id);
       --  Determine whether Body_Decl denotes the body of a late controlled
       --  primitive (either Initialize, Adjust or Finalize). If this is the
@@ -2189,6 +2196,56 @@
          end loop;
       end Adjust_Decl;
 
+      ---------------------------
+      -- Check_Entry_Contracts --
+      ---------------------------
+
+      procedure Check_Entry_Contracts is
+         ASN : Node_Id;
+         Ent : Entity_Id;
+         Exp : Node_Id;
+
+      begin
+         Ent := First_Entity (Current_Scope);
+         while Present (Ent) loop
+
+            --  This only concerns entries with pre/postconditions
+
+            if Ekind (Ent) = E_Entry
+              and then Present (Contract (Ent))
+              and then Present (Pre_Post_Conditions (Contract (Ent)))
+            then
+               ASN := Pre_Post_Conditions (Contract (Ent));
+               Push_Scope (Ent);
+               Install_Formals (Ent);
+
+               --  Pre/postconditions are rewritten as Check pragmas. Analysis
+               --  is performed on a copy of the pragma expression, to prevent
+               --  modifying the original expression.
+
+               while Present (ASN) loop
+                  if Nkind (ASN) = N_Pragma then
+                     Exp :=
+                       New_Copy_Tree
+                         (Expression
+                           (First (Pragma_Argument_Associations (ASN))));
+                     Set_Parent (Exp, ASN);
+
+                     --  ??? why not Preanalyze_Assert_Expression
+
+                     Preanalyze (Exp);
+                  end if;
+
+                  ASN := Next_Pragma (ASN);
+               end loop;
+
+               End_Scope;
+            end if;
+
+            Next_Entity (Ent);
+         end loop;
+      end Check_Entry_Contracts;
+
       --------------------------------------
       -- Handle_Late_Controlled_Primitive --
       --------------------------------------
@@ -2349,12 +2406,14 @@
          --  (This is needed in any case for early instantiations ???).
 
          if No (Next_Decl) then
-            if Nkind_In (Parent (L), N_Component_List,
-                                     N_Task_Definition,
-                                     N_Protected_Definition)
-            then
+            if Nkind (Parent (L)) = N_Component_List then
                null;
 
+            elsif Nkind_In (Parent (L), N_Protected_Definition,
+                                        N_Task_Definition)
+            then
+               Check_Entry_Contracts;
+
             elsif Nkind (Parent (L)) /= N_Package_Specification then
                if Nkind (Parent (L)) = N_Package_Body then
                   Freeze_From := First_Entity (Current_Scope);
Index: sem_attr.adb
===================================================================
--- sem_attr.adb        (revision 237507)
+++ sem_attr.adb        (working copy)
@@ -5348,7 +5348,9 @@
             if Is_Entity_Name (P) then
                Pref_Id := Entity (P);
 
-               if Ekind_In (Pref_Id, E_Function, E_Generic_Function) then
+               if Ekind_In (Pref_Id, E_Function, E_Generic_Function)
+                 and then Ekind (Spec_Id) = Ekind (Pref_Id)
+               then
                   if Denote_Same_Function (Pref_Id, Spec_Id) then
 
                      --  Correct the prefix of the attribute when the context

Reply via email to