From 3603fa5cfb32ced1402f31b174a3023826745160 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 13 Jan 2017 11:39:38 +0100 Subject: [PATCH] Code cleanups. From-SVN: r244412 --- gcc/ada/contracts.adb | 29 +++++++++++++++++++++++++++-- gcc/ada/contracts.ads | 5 +++-- 2 files changed, 30 insertions(+), 4 deletions(-) diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb index 3a013d9257f..862e85b7424 100644 --- a/gcc/ada/contracts.adb +++ b/gcc/ada/contracts.adb @@ -1085,8 +1085,10 @@ package body Contracts is -------------------------------- procedure Analyze_Previous_Contracts (Body_Decl : Node_Id) is - Body_Id : constant Entity_Id := Defining_Entity (Body_Decl); - Par : Node_Id; + Body_Id : constant Entity_Id := Defining_Entity (Body_Decl); + Orig_Decl : constant Node_Id := Original_Node (Body_Decl); + + Par : Node_Id; begin -- A body that is in the process of being inlined appears from source, @@ -1109,6 +1111,29 @@ package body Contracts is Freeze_Id => Defining_Entity (Body_Decl)); exit; + + -- Do not look for an enclosing package body when the construct which + -- causes freezing is a body generated for an expression function and + -- it appears within a package spec. This ensures that the traversal + -- will not reach too far up the parent chain and attempt to freeze a + -- package body which should not be frozen. + + -- package body Enclosing_Body + -- with Refined_State => (State => Var) + -- is + -- package Nested is + -- type Some_Type is ...; + -- function Cause_Freezing return ...; + -- private + -- function Cause_Freezing is (...); + -- end Nested; + -- + -- Var : Nested.Some_Type; + + elsif Nkind (Par) = N_Package_Declaration + and then Nkind (Orig_Decl) = N_Expression_Function + then + exit; end if; Par := Parent (Par); diff --git a/gcc/ada/contracts.ads b/gcc/ada/contracts.ads index 1059fc63157..d40200e183d 100644 --- a/gcc/ada/contracts.ads +++ b/gcc/ada/contracts.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2015, Free Software Foundation, Inc. -- +-- Copyright (C) 2015-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -131,7 +131,8 @@ package Contracts is procedure Analyze_Previous_Contracts (Body_Decl : Node_Id); -- Analyze the contracts of all source constructs found in the declarative -- list which contains entry, package, protected, subprogram, or task body - -- denoted by Body_Decl. The analysis stops once Body_Decl is reached. + -- denoted by Body_Decl. The analysis stops once Body_Decl is reached. In + -- addition, analyze the contract of the nearest enclosing package body. procedure Analyze_Protected_Contract (Prot_Id : Entity_Id); -- Analyze all delayed pragmas chained on the contract of protected unit -- 2.30.2