From 19b00ffa9cb1ea393788d483d554c17513407992 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Thu, 17 Sep 2020 16:11:56 +0200 Subject: [PATCH] [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. --- gcc/ada/contracts.adb | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) 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; ---------------------- -- 2.30.2