diff mbox

[Ada] Spurious errors on instances of formal packages with defaults.

Message ID 20161012103321.GA60669@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Oct. 12, 2016, 10:33 a.m. UTC 
This patch fixes spurious errors on instantiations of formal packages that
have defaulted formals that include tagged private types and array types.

The following must compile quietly:

   gcc -c lis3dsh_spi.ads

---
with SPI_Bus_Driver;
with LIS3DSH;

package LIS3DSH_SPI is new LIS3DSH (IO => SPI_Bus_Driver);

package HAL.SPI is

   type SPI_Data_8b is array (Natural range <>) of Byte;

   type SPI_Port is limited interface;

end HAL.SPI;
---
with Interfaces;

package HAL is
   pragma Pure;

   subtype Word is Interfaces.Unsigned_32;
   subtype Short is Interfaces.Unsigned_16;
   subtype Byte is Interfaces.Unsigned_8;

end HAL;
with HAL;
with Peripheral_Bus_Driver;  -- signature

generic
   --  This device can be connected through I2C or SPI.
   with package IO is new Peripheral_Bus_Driver
     (Address => HAL.Byte,
      Data    => HAL.Byte,
      others  => <>);
package LIS3DSH is

   --  various routines that will call IO routines ...

end LIS3DSH;
---
generic

   type Device_Bus is abstract tagged limited private;

   type Address is private;

   type Data is private;

   type Buffer is array (Natural range <>) of Data;

   with procedure Read
     (This   : in out Device_Bus'Class;
      Value  : out Data;
      Source : Address);

   with procedure Write
     (This        : in out Device_Bus'Class;
      Value       : Data;
      Destination : Address);

   with procedure Read_Buffer
     (This   : in out Device_Bus'Class;
      Value  : out Buffer;
      Source : Address);

   with procedure Write_Buffer
     (This        : in out Device_Bus'Class;
      Value       : Buffer;
      Destination : Address);

package Peripheral_Bus_Driver is end;
---
with HAL.SPI;
with SPI_Byte_IO;
with Peripheral_Bus_Driver;

package SPI_Bus_Driver is new Peripheral_Bus_Driver
  (Device_Bus   => HAL.SPI.SPI_Port,
   Address      => HAL.Byte,
   Data         => HAL.Byte,
   Buffer       => HAL.SPI.SPI_Data_8b,
   Read         => SPI_Byte_IO.Read,
   Write        => SPI_Byte_IO.Write,
   Read_Buffer  => SPI_Byte_IO.Read_Buffer,
   Write_Buffer => SPI_Byte_IO.Write_Buffer);

---
with HAL.SPI;   use HAL.SPI;
use HAL;

package SPI_Byte_IO is

   procedure Read
     (This   : in out SPI_Port'Class;
      Value  : out Byte;
      Source : Byte);

   procedure Write
     (This        : in out SPI_Port'Class;
      Value       : Byte;
      Destination : Byte);

   procedure Read_Buffer
     (This   : in out SPI_Port'Class;
      Value  : out SPI_Data_8b;
      Source : Byte);

   procedure Write_Buffer
     (This        : in out SPI_Port'Class;
      Value       : SPI_Data_8b;
      Destination : Byte);

end SPI_Byte_IO;

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

2016-10-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Check_Formal_Package_Instance): Handle properly
	an instance of a formal package with defaults, when defaulted
	parameters include tagged private types and array types.
diff mbox

Patch

Index: sem_ch12.adb
===================================================================
--- sem_ch12.adb	(revision 241024)
+++ sem_ch12.adb	(working copy)
@@ -5787,8 +5787,9 @@ 
      (Formal_Pack : Entity_Id;
       Actual_Pack : Entity_Id)
    is
-      E1 : Entity_Id := First_Entity (Actual_Pack);
-      E2 : Entity_Id := First_Entity (Formal_Pack);
+      E1      : Entity_Id := First_Entity (Actual_Pack);
+      E2      : Entity_Id := First_Entity (Formal_Pack);
+      Prev_E1 : Entity_Id;
 
       Expr1 : Node_Id;
       Expr2 : Node_Id;
@@ -5954,6 +5955,7 @@ 
    --  Start of processing for Check_Formal_Package_Instance
 
    begin
+      Prev_E1 := E1;
       while Present (E1) and then Present (E2) loop
          exit when Ekind (E1) = E_Package
            and then Renamed_Entity (E1) = Renamed_Entity (Actual_Pack);
@@ -5983,6 +5985,14 @@ 
          if No (E1) then
             return;
 
+         --  Entities may be declared without full declaration, such as
+         --  itypes and predefined operators (concatenation for arrays, eg).
+         --  Skip it and keep the formal entity to find a later match for it.
+
+         elsif No (Parent (E2)) then
+            E1 := Prev_E1;
+            goto Next_E;
+
          --  If the formal entity comes from a formal declaration, it was
          --  defaulted in the formal package, and no check is needed on it.
 
@@ -5990,6 +6000,13 @@ 
                          N_Formal_Object_Declaration,
                          N_Formal_Type_Declaration)
          then
+            --  If the formal is a tagged type the corresponding class-wide
+            --  type has been generated as well, and it must be skipped.
+
+            if Is_Type (E2) and then Is_Tagged_Type (E2) then
+               Next_Entity (E2);
+            end if;
+
             goto Next_E;
 
          --  Ditto for defaulted formal subprograms.
@@ -6144,6 +6161,7 @@ 
          end if;
 
          <<Next_E>>
+            Prev_E1 := E1;
             Next_Entity (E1);
             Next_Entity (E2);
       end loop;