[Ada] Spurious errors on instances of formal packages with defaults.
Arnaud Charlet
charlet@adacore.com
Wed Oct 12 10:33:00 GMT 2016
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.
-------------- next part --------------
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;
More information about the Gcc-patches
mailing list