sem_ch6.adb (Analyze_Expression_Function): If expression function is completion and...

2017-04-25  Ed Schonberg  <schonberg@adacore.com>

	* 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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7f7a28a40575457392c04e617789a4579645b3b5..da7cb6f00ffdfdcc0bbbaabc43d33dfe6521c03b 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,15 @@
+2017-04-25  Ed Schonberg  <schonberg@adacore.com>
+
+       * 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  <obry@adacore.com>
 
        * 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 38e8279aad5ede544eb7e1c1d53ec0918a6eacc0..16a586b34222cd502b8259441ca339f409488610 100644 (file)
--- 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 da261e9107f6b9917fcf5e2cc5958fabb3fe6d2f..e8f29df64b0ca6a2b1f6c225510bdf63ed605908 100644 (file)
--- 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;