[Ada] Handle new inequality errors in Ada 2012 more completely

Arnaud Charlet charlet@adacore.com
Wed Jan 22 16:47:00 GMT 2014


This patch does two things with respect to the new illegalities in Ada
2012 regarding late declaration of equality for untagged types. First
these errors can be converted to warnings using the -gnatd.E switch.
Second, in earlier versions of Ada, if the -gnatwy switch is set (warn
on Ada incompatibilities, set by default), then warnings are generated
for these situations.

The following test compiles quietly in Ada 95 mode with -gnatwY

     1. package LateEq is
     2.    type R is record
     3.       M : Float;
     4.    end record;
     5.    MM : R;
     6.    function "=" (X, Y : R) return Boolean;
     7. end;

In Ada 2012 mode we get:

     1. package LateEq is
     2.    type R is record
     3.       M : Float;
     4.    end record;
     5.    MM : R;
           |
        >>> warning: type "R" is frozen by declaration, an
            equality operator cannot be declared after this
            point

     6.    function "=" (X, Y : R) return Boolean;
                    |
        >>> equality operator must be declared before type
            "R" is frozen (RM 4.5.2 (9.8)) (Ada 2012)

     7. end;

That error turns into a warning if we set debug flag -gnatd.E

     1. package LateEq is
     2.    type R is record
     3.       M : Float;
     4.    end record;
     5.    MM : R;
           |
        >>> warning: type "R" is frozen by declaration, an
            equality operator cannot be declared after this
            point

     6.    function "=" (X, Y : R) return Boolean;
                    |
        >>> warning: equality operator must be declared
            before type "R" is frozen (RM 4.5.2 (9.8)) (Ada
            2012), equality operation may not compose

     7. end;

Finally we get warnings if we run in Ada 95 mode with the
warnings -gnatwy.d (-gnatwy is the default):

     1. package LateEq is
     2.    type R is record
     3.       M : Float;
     4.    end record;
     5.    MM : R;
           |
        >>> warning: type "R" is frozen by declaration (Ada
            2012), an equality operator cannot be declared
            after this point (Ada 2012) [-gnatwy]

     6.    function "=" (X, Y : R) return Boolean;
                    |
        >>> warning: equality operator must be declared
            before type "R" is frozen (RM 4.5.2 (9.8)) (Ada
            2012) [-gnatwy]

     7. end;

Tested on x86_64-pc-linux-gnu, committed on trunk

2014-01-22  Robert Dewar  <dewar@adacore.com>

	* debug.adb: Document messages affected by -gnatd.E including
	the new ones that relate to late definition of equality.
	* sem_ch6.adb (Check_Untagged_Equality): In Ada 2012 mode, if
	debug flag -gnatd.E is set, then generate warnings rather than
	errors.
	(Check_Untagged_Equality): In earlier versions of Ada,
	generate warnings if Warn_On_Ada_2012_Incompatibility flag is set.

-------------- next part --------------
Index: debug.adb
===================================================================
--- debug.adb	(revision 206928)
+++ debug.adb	(working copy)
@@ -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.
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb	(revision 206918)
+++ sem_ch6.adb	(working copy)
@@ -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;
 


More information about the Gcc-patches mailing list