From 241f328c235be95a49c25681af0ccd34985560e1 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Tue, 25 Apr 2017 12:55:11 +0000 Subject: [PATCH] sem_ch6.adb (Analyze_Expression_Function): If expression function is completion and return type is an access type do not... 2017-04-25 Ed Schonberg * sem_ch6.adb (Analyze_Expression_Function): If expression function is completion and return type is an access type do not freeze designated type: this will be done in the process of freezing the expression if needed. (Freeze_Expr_Types): Check whether type is complete before creating freeze node, to provide a better error message if reference is premature. * sem_ch13.adb (Check_Indexing_Functions): Ignore inherited functions created by type derivations. From-SVN: r247217 --- gcc/ada/ChangeLog | 12 ++++++++++++ gcc/ada/sem_ch13.adb | 10 +++++++++- gcc/ada/sem_ch6.adb | 26 +++++++++++++++++++++----- 3 files changed, 42 insertions(+), 6 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7f7a28a..da7cb6f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2017-04-25 Ed Schonberg + + * sem_ch6.adb (Analyze_Expression_Function): If expression function + is completion and return type is an access type do not freeze + designated type: this will be done in the process of freezing + the expression if needed. + (Freeze_Expr_Types): Check whether type is complete before + creating freeze node, to provide a better error message if + reference is premature. + * sem_ch13.adb (Check_Indexing_Functions): Ignore inherited + functions created by type derivations. + 2017-04-25 Pascal Obry * g-sercom.ads: Add simple usage of GNAT.Serial_Communication. diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 38e8279..16a586b 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -4374,7 +4374,15 @@ package body Sem_Ch13 is -- subprogram itself. if Is_Overloadable (It.Nam) then - Check_One_Function (It.Nam); + + -- Ignore homonyms that may come from derived types + -- in the context. + + if not Comes_From_Source (It.Nam) then + null; + else + Check_One_Function (It.Nam); + end if; end if; Get_Next_Interp (I, It); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index da261e9..e8f29df 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -403,10 +403,6 @@ package body Sem_Ch6 is end if; end if; - if Is_Access_Type (Etype (Prev)) then - Freeze_Before (N, Designated_Type (Etype (Prev))); - end if; - -- For navigation purposes, indicate that the function is a body Generate_Reference (Prev, Defining_Entity (N), 'b', Force => True); @@ -3089,7 +3085,27 @@ package body Sem_Ch6 is elsif Ekind_In (Entity (Node), E_Component, E_Discriminant) then - Freeze_Before (N, Scope (Entity (Node))); + declare + Rec : constant Entity_Id := Scope (Entity (Node)); + begin + + -- Check that the enclosing record type can be frozen. + -- This provides a better error message than generating + -- primitives whose compilation fails much later. + -- Refine the error message if possible. + + Check_Fully_Declared (Rec, Node); + + if Error_Posted (Node) then + if Has_Private_Component (Rec) then + Error_Msg_NE ("\type& has private component", + Node, Rec); + end if; + + else + Freeze_Before (N, Rec); + end if; + end; end if; end if; -- 2.7.4