diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 4d766b9433b82d2156bdfe22de37dea81a735c43..e4af71cef26fd0200b29aac898c95668420945fc 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -4743,6 +4743,12 @@ package body Sem_Ch6 is
Style.Body_With_No_Spec (N);
end if;
+ -- First set Acts_As_Spec if appropriate
+
+ if Nkind (N) /= N_Subprogram_Body_Stub then
+ Set_Acts_As_Spec (N);
+ end if;
+
New_Overloaded_Entity (Body_Id);
-- A subprogram body should cause freezing of its own declaration,
@@ -4767,7 +4773,6 @@ package body Sem_Ch6 is
end if;
if Nkind (N) /= N_Subprogram_Body_Stub then
- Set_Acts_As_Spec (N);
Generate_Definition (Body_Id);
Generate_Reference
(Body_Id, Body_Id, 'b', Set_Ref => False, Force => True);
@@ -9525,15 +9530,85 @@ package body Sem_Ch6 is
-----------------------------
procedure Check_Untagged_Equality (Eq_Op : Entity_Id) is
- Typ : constant Entity_Id := Etype (First_Formal (Eq_Op));
- Decl : constant Node_Id := Unit_Declaration_Node (Eq_Op);
- Obj_Decl : Node_Id;
+ Eq_Decl : constant Node_Id := Unit_Declaration_Node (Eq_Op);
+ Typ : constant Entity_Id := Etype (First_Formal (Eq_Op));
+
+ procedure Freezing_Point_Warning (N : Node_Id; S : String);
+ -- Output a warning about the freezing point N of Typ
+
+ function Is_Actual_Of_Instantiation
+ (E : Entity_Id;
+ Inst : Node_Id) return Boolean;
+ -- Return True if E is an actual parameter of instantiation Inst
+
+ -----------------------------------
+ -- Output_Freezing_Point_Warning --
+ -----------------------------------
+
+ procedure Freezing_Point_Warning (N : Node_Id; S : String) is
+ begin
+ Error_Msg_String (1 .. S'Length) := S;
+ Error_Msg_Strlen := S'Length;
+
+ if Ada_Version >= Ada_2012 then
+ Error_Msg_NE ("type& is frozen by ~??", N, Typ);
+ Error_Msg_N
+ ("\an equality operator cannot be declared after this point??",
+ N);
+
+ else
+ Error_Msg_NE ("type& is frozen by ~ (Ada 2012)?y?", N, Typ);
+ Error_Msg_N
+ ("\an equality operator cannot be declared after this point"
+ & " (Ada 2012)?y?", N);
+ end if;
+ end Freezing_Point_Warning;
+
+ --------------------------------
+ -- Is_Actual_Of_Instantiation --
+ --------------------------------
+
+ function Is_Actual_Of_Instantiation
+ (E : Entity_Id;
+ Inst : Node_Id) return Boolean
+ is
+ Assoc : Node_Id;
+
+ begin
+ if Present (Generic_Associations (Inst)) then
+ Assoc := First (Generic_Associations (Inst));
+
+ while Present (Assoc) loop
+ if Present (Explicit_Generic_Actual_Parameter (Assoc))
+ and then
+ Is_Entity_Name (Explicit_Generic_Actual_Parameter (Assoc))
+ and then
+ Entity (Explicit_Generic_Actual_Parameter (Assoc)) = E
+ then
+ return True;
+ end if;
+
+ Next (Assoc);
+ end loop;
+ end if;
+
+ return False;
+ end Is_Actual_Of_Instantiation;
+
+ -- Local variable
+
+ Decl : Node_Id;
+
+ -- Start of processing for Check_Untagged_Equality
begin
- -- This check applies only if we have a subprogram declaration with an
- -- untagged record type that is conformant to the predefined operator.
+ -- This check applies only if we have a subprogram declaration or a
+ -- subprogram body that is not a completion, for an untagged record
+ -- type, and that is conformant with the predefined operator.
- if Nkind (Decl) /= N_Subprogram_Declaration
+ if (Nkind (Eq_Decl) /= N_Subprogram_Declaration
+ and then not (Nkind (Eq_Decl) = N_Subprogram_Body
+ and then Acts_As_Spec (Eq_Decl)))
or else not Is_Record_Type (Typ)
or else Is_Tagged_Type (Typ)
or else not Is_User_Defined_Equality (Eq_Op)
@@ -9572,9 +9647,59 @@ package body Sem_Ch6 is
elsif Is_Generic_Actual_Type (Typ) then
return;
- -- Here we have a definite error of declaration after freezing
+ -- Here we may have an error of declaration after freezing, but we
+ -- must make sure not to flag the equality operator itself causing
+ -- the freezing when it is a subprogram body.
else
+ Decl := Next (Declaration_Node (Typ));
+
+ while Present (Decl) and then Decl /= Eq_Decl loop
+
+ -- The declaration of an object of the type
+
+ if Nkind (Decl) = N_Object_Declaration
+ and then Etype (Defining_Identifier (Decl)) = Typ
+ then
+ Freezing_Point_Warning (Decl, "declaration");
+ exit;
+
+ -- The instantiation of a generic on the type
+
+ elsif Nkind (Decl) in N_Generic_Instantiation
+ and then Is_Actual_Of_Instantiation (Typ, Decl)
+ then
+ Freezing_Point_Warning (Decl, "instantiation");
+ exit;
+
+ -- A noninstance proper body, body stub or entry body
+
+ elsif Nkind (Decl) in N_Proper_Body
+ | N_Body_Stub
+ | N_Entry_Body
+ and then not Is_Generic_Instance (Defining_Entity (Decl))
+ then
+ Freezing_Point_Warning (Decl, "body");
+ exit;
+
+ -- If we have reached the freeze node and immediately after we
+ -- have the body or generated code for the body, then it is the
+ -- body that caused the freezing and this is legal.
+
+ elsif Nkind (Decl) = N_Freeze_Entity
+ and then Entity (Decl) = Typ
+ and then (Next (Decl) = Eq_Decl
+ or else
+ Sloc (Next (Decl)) = Sloc (Eq_Decl))
+ then
+ return;
+ end if;
+
+ Next (Decl);
+ end loop;
+
+ -- Here we have a definite error of declaration after freezing
+
if Ada_Version >= Ada_2012 then
Error_Msg_NE
("equality operator must be declared before type & is "
@@ -9594,57 +9719,32 @@ package body Sem_Ch6 is
& "frozen (RM 4.5.2 (9.8)) (Ada 2012)?y?", Eq_Op, Typ);
end if;
- -- If we are in the package body, we could just move the
- -- declaration to the package spec, so add a message saying that.
+ -- If we have found no freezing point and the declaration of the
+ -- operator could not be reached from that of the type and we are
+ -- in a package body, this must be because the type is declared
+ -- in the spec of the package. Add a message tailored to this.
- if In_Package_Body (Scope (Typ)) then
+ if No (Decl) and then In_Package_Body (Scope (Typ)) then
if Ada_Version >= Ada_2012 then
- Error_Msg_N
- ("\move declaration to package spec<<", Eq_Op);
- else
- Error_Msg_N
- ("\move declaration to package spec (Ada 2012)?y?", Eq_Op);
- end if;
-
- -- Otherwise try to find the freezing point for better message.
-
- else
- Obj_Decl := Next (Parent (Typ));
- while Present (Obj_Decl) and then Obj_Decl /= Decl loop
- if Nkind (Obj_Decl) = N_Object_Declaration
- and then Etype (Defining_Identifier (Obj_Decl)) = Typ
- then
- -- Freezing point, output warnings
-
- if Ada_Version >= Ada_2012 then
- Error_Msg_NE
- ("type& is frozen by declaration??", Obj_Decl, Typ);
- Error_Msg_N
- ("\an equality operator cannot be declared after "
- & "this point??",
- Obj_Decl);
- else
- Error_Msg_NE
- ("type& is frozen by declaration (Ada 2012)?y?",
- Obj_Decl, Typ);
- Error_Msg_N
- ("\an equality operator cannot be declared after "
- & "this point (Ada 2012)?y?",
- Obj_Decl);
- end if;
-
- exit;
-
- -- If we reach generated code for subprogram declaration
- -- or body, it is the body that froze the type and the
- -- declaration is legal.
-
- elsif Sloc (Obj_Decl) = Sloc (Decl) then
- return;
+ if Nkind (Eq_Decl) = N_Subprogram_Body then
+ Error_Msg_N
+ ("\put declaration in package spec<<", Eq_Op);
+ else
+ Error_Msg_N
+ ("\move declaration to package spec<<", Eq_Op);
end if;
- Next (Obj_Decl);
- end loop;
+ else
+ if Nkind (Eq_Decl) = N_Subprogram_Body then
+ Error_Msg_N
+ ("\put declaration in package spec (Ada 2012)?y?",
+ Eq_Op);
+ else
+ Error_Msg_N
+ ("\move declaration to package spec (Ada 2012)?y?",
+ Eq_Op);
+ end if;
+ end if;
end if;
end if;
@@ -9653,21 +9753,21 @@ package body Sem_Ch6 is
-- a type has been derived from T.
else
- Obj_Decl := Next (Parent (Typ));
+ Decl := Next (Declaration_Node (Typ));
- while Present (Obj_Decl) and then Obj_Decl /= Decl loop
- if Nkind (Obj_Decl) = N_Full_Type_Declaration
- and then Etype (Defining_Identifier (Obj_Decl)) = Typ
+ while Present (Decl) and then Decl /= Eq_Decl loop
+ if Nkind (Decl) = N_Full_Type_Declaration
+ and then Etype (Defining_Identifier (Decl)) = Typ
then
Error_Msg_N
("equality operator cannot appear after derivation", Eq_Op);
Error_Msg_NE
("an equality operator for& cannot be declared after "
& "this point??",
- Obj_Decl, Typ);
+ Decl, Typ);
end if;
- Next (Obj_Decl);
+ Next (Decl);
end loop;
end if;
end Check_Untagged_Equality;
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 1412d94198c7b08a01d0ab96c7271b44c16e9e64..44fc955de74a5394ace16e149fcf998398faa110 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -8967,14 +8967,7 @@ package body Sem_Res is
then
Eq := Get_User_Defined_Equality (T);
- -- We need to make sure that the instance is not within the
- -- same declarative region as the type, or else that it lies
- -- after the declaration of the user-defined "=" operator.
-
- if Present (Eq)
- and then (not In_Same_Extended_Unit (Eq, N)
- or else Earlier_In_Extended_Unit (Eq, N))
- then
+ if Present (Eq) then
if Is_Abstract_Subprogram (Eq) then
Nondispatching_Call_To_Abstract_Operation (N, Eq);
else