===================================================================
@@ -596,10 +596,16 @@
-- d.E Turn selected errors into warnings. This debug switch causes a
-- specific set of error messages into warnings. Setting this switch
- -- causes Opt.Error_To_Warning to be set to True. Right now the only
- -- error affected is the case of overlapping subprogram parameters
- -- which has become illegal in Ada 2012, but only generates a warning
- -- in earlier versions of Ada.
+ -- causes Opt.Error_To_Warning to be set to True. The intention is
+ -- that this be used for messages representing upwards incompatible
+ -- changes to Ada 2012 that cause previously correct programs to be
+ -- treated as illegal now. The following cases are affected:
+ --
+ -- Errors relating to overlapping subprogram parameters for cases
+ -- other than IN OUT parameters to functions.
+ --
+ -- Errors relating to the new rules about not defining equality
+ -- too late so that composition of equality can be assured.
-- d.F Sets GNATprove_Mode to True. This allows debugging the frontend in
-- the special mode used by GNATprove.
===================================================================
@@ -193,7 +193,10 @@
-- must appear before the type is frozen, and have the same visibility as
-- that of the type. This procedure checks that this rule is met, and
-- otherwise emits an error on the subprogram declaration and a warning
- -- on the earlier freeze point if it is easy to locate.
+ -- on the earlier freeze point if it is easy to locate. In Ada 2012 mode,
+ -- this routine outputs errors (or warnings if -gnatd.E is set). In earlier
+ -- versions of Ada, warnings are output if Warn_On_Ada_2012_Incompatibility
+ -- is set, otherwise the call has no effect.
procedure Enter_Overloaded_Entity (S : Entity_Id);
-- This procedure makes S, a new overloaded entity, into the first visible
@@ -8198,63 +8201,140 @@
Obj_Decl : Node_Id;
begin
- if Nkind (Decl) = N_Subprogram_Declaration
- and then Is_Record_Type (Typ)
- and then not Is_Tagged_Type (Typ)
+ -- This check applies only if we have a subprogram declaration with a
+ -- non-tagged record type.
+
+ if Nkind (Decl) /= N_Subprogram_Declaration
+ or else not Is_Record_Type (Typ)
+ or else Is_Tagged_Type (Typ)
then
- -- If the type is not declared in a package, or if we are in the
- -- body of the package or in some other scope, the new operation is
- -- not primitive, and therefore legal, though suspicious. If the
- -- type is a generic actual (sub)type, the operation is not primitive
- -- either because the base type is declared elsewhere.
+ return;
+ end if;
- if Is_Frozen (Typ) then
- if Ekind (Scope (Typ)) /= E_Package
- or else Scope (Typ) /= Current_Scope
- then
- null;
+ -- In Ada 2012 case, we will output errors or warnings depending on
+ -- the setting of debug flag -gnatd.E.
- elsif Is_Generic_Actual_Type (Typ) then
- null;
+ if Ada_Version >= Ada_2012 then
+ Error_Msg_Warn := Debug_Flag_Dot_EE;
- elsif In_Package_Body (Scope (Typ)) then
+ -- In earlier versions of Ada, nothing to do unless we are warning on
+ -- Ada 2012 incompatibilities (Warn_On_Ada_2012_Incompatibility set).
+
+ else
+ if not Warn_On_Ada_2012_Compatibility then
+ return;
+ end if;
+ end if;
+
+ -- Cases where the type has already been frozen
+
+ if Is_Frozen (Typ) then
+
+ -- If the type is not declared in a package, or if we are in the body
+ -- of the package or in some other scope, the new operation is not
+ -- primitive, and therefore legal, though suspicious. Should we
+ -- generate a warning in this case ???
+
+ if Ekind (Scope (Typ)) /= E_Package
+ or else Scope (Typ) /= Current_Scope
+ then
+ return;
+
+ -- If the type is a generic actual (sub)type, the operation is not
+ -- primitive either because the base type is declared elsewhere.
+
+ elsif Is_Generic_Actual_Type (Typ) then
+ return;
+
+ -- Here we have a definite error of declaration after freezing
+
+ else
+ if Ada_Version >= Ada_2012 then
Error_Msg_NE
- ("equality operator must be declared "
- & "before type& is frozen", Eq_Op, Typ);
- Error_Msg_N
- ("\move declaration to package spec", Eq_Op);
+ ("equality operator must be declared before type& is "
+ & "frozen (RM 4.5.2 (9.8)) (Ada 2012)<<", Eq_Op, Typ);
+ -- In Ada 2012 mode with error turned to warning, output one
+ -- more warning to warn that the equality operation may not
+ -- compose. This is the consequence of ignoring the error.
+
+ if Error_Msg_Warn then
+ Error_Msg_N ("\equality operation may not compose??", Eq_Op);
+ end if;
+
else
Error_Msg_NE
- ("equality operator must be declared "
- & "before type& is frozen", Eq_Op, Typ);
+ ("equality operator must be declared before type& 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 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
+
+ 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
- Error_Msg_NE
- ("type& is frozen by declaration??", Obj_Decl, Typ);
- Error_Msg_N
- ("\an equality operator cannot be declared after this "
- & "point (RM 4.5.2 (9.8)) (Ada 2012))??", Obj_Decl);
+ -- 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;
end if;
Next (Obj_Decl);
end loop;
end if;
+ end if;
- elsif not In_Same_List (Parent (Typ), Decl)
- and then not Is_Limited_Type (Typ)
- then
+ -- Here if type is not frozen yet. It is illegal to have a primitive
+ -- equality declared in the private part if the type is visible.
- -- This makes it illegal to have a primitive equality declared in
- -- the private part if the type is visible.
+ elsif not In_Same_List (Parent (Typ), Decl)
+ and then not Is_Limited_Type (Typ)
+ then
+ -- Shouldn't we give an RM reference here???
- Error_Msg_N ("equality operator appears too late", Eq_Op);
+ if Ada_Version >= Ada_2012 then
+ Error_Msg_N
+ ("equality operator appears too late<<", Eq_Op);
+ else
+ Error_Msg_N
+ ("equality operator appears too late (Ada 2012)?y?", Eq_Op);
end if;
+
+ -- No error detected
+
+ else
+ return;
end if;
end Check_Untagged_Equality;
@@ -10796,10 +10876,7 @@
and then not Is_Dispatching_Operation (S)
then
Make_Inequality_Operator (S);
-
- if Ada_Version >= Ada_2012 then
- Check_Untagged_Equality (S);
- end if;
+ Check_Untagged_Equality (S);
end if;
end New_Overloaded_Entity;