From: Piotr Trojanek <trojanek@adacore.com>
Date: Thu, 17 Sep 2020 14:11:56 +0000 (+0200)
Subject: [Ada] Fix freezing of previous contracts
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=19b00ffa9cb1ea393788d483d554c17513407992;p=gcc.git

[Ada] Fix freezing of previous contracts

gcc/ada/

	* contracts.adb (Causes_Contract_Freezing): Extend condition to
	match the one in Analyze_Subprogram_Body_Helper. This routine is
	used both as an assertion at the very start of
	Freeze_Previous_Contracts and to detect previous declaration for
	which Freeze_Previous_Contracts has been executed.
---

diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb
index 9e328e248db..936b16e8176 100644
--- a/gcc/ada/contracts.adb
+++ b/gcc/ada/contracts.adb
@@ -2833,7 +2833,10 @@ package body Contracts is
    procedure Freeze_Previous_Contracts (Body_Decl : Node_Id) is
       function Causes_Contract_Freezing (N : Node_Id) return Boolean;
       pragma Inline (Causes_Contract_Freezing);
-      --  Determine whether arbitrary node N causes contract freezing
+      --  Determine whether arbitrary node N causes contract freezing. This is
+      --  used as an assertion for the current body declaration that caused
+      --  contract freezing, and as a condition to detect body declaration that
+      --  already caused contract freezing before.
 
       procedure Freeze_Contracts;
       pragma Inline (Freeze_Contracts);
@@ -2851,9 +2854,17 @@ package body Contracts is
 
       function Causes_Contract_Freezing (N : Node_Id) return Boolean is
       begin
-         return Nkind (N) in
-           N_Entry_Body      | N_Package_Body         | N_Protected_Body |
-           N_Subprogram_Body | N_Subprogram_Body_Stub | N_Task_Body;
+         --  The following condition matches guards for calls to
+         --  Freeze_Previous_Contracts from routines that analyze various body
+         --  declarations. In particular, it detects expression functions, as
+         --  described in the call from Analyze_Subprogram_Body_Helper.
+
+         return
+           Comes_From_Source (Original_Node (N))
+             and then
+           Nkind (N) in
+             N_Entry_Body      | N_Package_Body         | N_Protected_Body |
+             N_Subprogram_Body | N_Subprogram_Body_Stub | N_Task_Body;
       end Causes_Contract_Freezing;
 
       ----------------------