[Ada] Missing consistency check for constant modifier

This patch fixes an issue whereby instantiations of generic packages
were incorrectly allowed despite formal and actual subprograms not
having matching declarations with anonymous constant access type
parameters.

------------
-- Source --
------------

-- gen1.ads

package Gen1 is
   generic
      with procedure View (IA : not null access constant Integer);
   procedure Dispatch (IA : access Integer);
end;

-- gen2.adb

package body Gen1 is
   procedure Dispatch (IA : access Integer) is
   begin
      View (IA);
   end;
end;

-- bad1.ads

with Gen1;
package Bad1 is
   procedure Bad_View (IA : not null access Integer);
   procedure Bad_Dispatch is new Gen1.Dispatch (Bad_View);
end;

-- bad1.adb

package body Bad1 is
   procedure Bad_View (IA : not null access Integer) is
   begin
      IA.all := IA.all + 1;
   end;
end;

-- gen2.ads

package Gen2 is
   generic
      with procedure View (IA : access constant Integer);
   procedure Dispatch (IA : access Integer);
end;

-- gen2.adb

package body Gen2 is
   procedure Dispatch (IA : access Integer) is
   begin
      View (IA);
   end;
end;

-- bad2.ads

with Gen2;
package Bad2 is
   procedure Bad_View (IA : access Integer);
   procedure Bad_Dispatch is new Gen2.Dispatch (Bad_View);
end;

-- bad2.adb

package body Bad2 is
   procedure Bad_View (IA : access Integer) is
   begin
      IA.all := IA.all + 1;
   end;
end;

-----------------
-- Compilation --
-----------------

$ gnatmake -q bad1.adb
$ bad1.ads:4:04: instantiation error at gen1.ads:3
$ bad1.ads:4:04: not mode conformant with declaration at line 3
$ bad1.ads:4:04: constant modifier does not match
$ gnatmake: "bad1.adb" compilation error
$ gnatmake -q bad2.adb
$ bad2.ads:4:04: instantiation error at gen2.ads:3
$ bad2.ads:4:04: not mode conformant with declaration at line 3
$ bad2.ads:4:04: constant modifier does not match
$ gnatmake: "bad2.adb" compilation error

2019-07-03  Justin Squirek  <squirek@adacore.com>

gcc/ada/

	* sem_ch6.adb (Check_Conformance): Add expression checking for
	constant modifiers in anonymous access types (in addition to
	"non-null" types) so that they are considered "matching" for
	subsequent conformance tests.

From-SVN: r272963

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ada9c2b4a56bb83c8df27de24fc58b5dd7db3754..879b776d0b4e8374f7046f470f343c221de96100 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2019-07-03  Justin Squirek  <squirek@adacore.com>
+
+       * sem_ch6.adb (Check_Conformance): Add expression checking for
+       constant modifiers in anonymous access types (in addition to
+       "non-null" types) so that they are considered "matching" for
+       subsequent conformance tests.
+
 2019-07-03  Arnaud Charlet  <charlet@adacore.com>
 
        * doc/gnat_rm/standard_and_implementation_defined_restrictions.rst:

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index d635543ce8693a2d3bec2f71c5daf296aaab0ac1..cf1b0e7322761752951f79000334b05baaa9fad8 100644 (file)
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -5444,10 +5444,14 @@ package body Sem_Ch6 is
                and then Directly_Designated_Type (Old_Formal_Base) =
                                     Directly_Designated_Type (New_Formal_Base)
            and then ((Is_Itype (Old_Formal_Base)
-                       and then Can_Never_Be_Null (Old_Formal_Base))
+                       and then (Can_Never_Be_Null (Old_Formal_Base)
+                                  or else Is_Access_Constant
+                                            (Old_Formal_Base)))
                      or else
                       (Is_Itype (New_Formal_Base)
-                        and then Can_Never_Be_Null (New_Formal_Base)));
+                        and then (Can_Never_Be_Null (New_Formal_Base)
+                                   or else Is_Access_Constant
+                                             (New_Formal_Base))));
 
          --  Types must always match. In the visible part of an instance,
          --  usual overloading rules for dispatching operations apply, and