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 <schonb...@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.
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;