From 77237288bdc644eed58d9e8bff1cad8c268a499d Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 26 Oct 2015 11:45:50 +0100 Subject: [PATCH] [multiple changes] 2015-10-26 Bob Duff * sem_ch13.adb (Check_Iterator_Functions): For a Default_Iterator aspect, make sure an implicitly declared interpretation is overridden by an explicit one. * sem_util.ads: Update comment. 2015-10-26 Hristian Kirtchev * sem_ch7.adb, sem_ch6.adb (Analyze_Subprogram_Body_Helper): Only source bodies should "freeze" the contract of the nearest enclosing package body. From-SVN: r229321 --- gcc/ada/ChangeLog | 13 +++++++++++++ gcc/ada/sem_ch13.adb | 23 ++++++++++++++++------- gcc/ada/sem_ch6.adb | 9 ++++++++- gcc/ada/sem_ch7.adb | 6 +++++- gcc/ada/sem_util.ads | 7 +++---- 5 files changed, 45 insertions(+), 13 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7b5a82872ac..232b1fc0b1b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2015-10-26 Bob Duff + + * sem_ch13.adb (Check_Iterator_Functions): For a Default_Iterator + aspect, make sure an implicitly declared interpretation is + overridden by an explicit one. + * sem_util.ads: Update comment. + +2015-10-26 Hristian Kirtchev + + * sem_ch7.adb, sem_ch6.adb (Analyze_Subprogram_Body_Helper): Only source + bodies should "freeze" the contract of the nearest enclosing + package body. + 2015-10-26 Joel Brobecker * adaint.c (__gnat_lwp_self): Replace current implementation re-using diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 06b5cf801f2..9ef6263846f 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -4277,8 +4277,8 @@ package body Sem_Ch13 is else declare Default : Entity_Id := Empty; - I : Interp_Index; - It : Interp; + I : Interp_Index; + It : Interp; begin Get_First_Interp (Expr, I, It); @@ -4289,12 +4289,21 @@ package body Sem_Ch13 is Remove_Interp (I); elsif Present (Default) then - Error_Msg_N ("default iterator must be unique", Expr); - Error_Msg_Sloc := Sloc (Default); - Error_Msg_N ("\\possible interpretation#", Expr); - Error_Msg_Sloc := Sloc (It.Nam); - Error_Msg_N ("\\possible interpretation#", Expr); + -- An explicit one should override an implicit one + + if Comes_From_Source (Default) = + Comes_From_Source (It.Nam) + then + Error_Msg_N ("default iterator must be unique", Expr); + Error_Msg_Sloc := Sloc (Default); + Error_Msg_N ("\\possible interpretation#", Expr); + Error_Msg_Sloc := Sloc (It.Nam); + Error_Msg_N ("\\possible interpretation#", Expr); + + elsif Comes_From_Source (It.Nam) then + Default := It.Nam; + end if; else Default := It.Nam; end if; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 283b770d611..0f2615861f8 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -3011,7 +3011,14 @@ package body Sem_Ch6 is -- decoupled from the usual Freeze_xxx mechanism because it must also -- work in the context of generics where normal freezing is disabled. - Analyze_Enclosing_Package_Body_Contract (N); + -- Only bodies coming from source should cause this type of "freezing". + -- Expression functions that act as bodies and complete an initial + -- declaration must be included in this category, hence the use of + -- Original_Node. + + if Comes_From_Source (Original_Node (N)) then + Analyze_Enclosing_Package_Body_Contract (N); + end if; -- Generic subprograms are handled separately. They always have a -- generic specification. Determine whether current scope has a diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 5814bc8eee3..48748440128 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -564,7 +564,11 @@ package body Sem_Ch7 is -- Freeze_xxx mechanism because it must also work in the context of -- generics where normal freezing is disabled. - Analyze_Enclosing_Package_Body_Contract (N); + -- Only bodies coming from source should cause this type of "freezing" + + if Comes_From_Source (N) then + Analyze_Enclosing_Package_Body_Contract (N); + end if; -- Find corresponding package specification, and establish the current -- scope. The visible defining entity for the package is the defining diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 81e63ed73d7..d7d08e6f59d 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -538,10 +538,9 @@ package Sem_Util is function Enclosing_Lib_Unit_Entity (E : Entity_Id := Current_Scope) return Entity_Id; - -- Returns the entity of enclosing library unit node which is the - -- root of the current scope (which must not be Standard_Standard, and the - -- caller is responsible for ensuring this condition) or other specified - -- entity. + -- Returns the entity of enclosing library unit node which is the root of + -- the current scope (which must not be Standard_Standard, and the caller + -- is responsible for ensuring this condition) or other specified entity. function Enclosing_Lib_Unit_Node (N : Node_Id) return Node_Id; -- Returns the N_Compilation_Unit node of the library unit that is directly -- 2.30.2