[Ada] Aggregates for type extensions with private ancestors.
Arnaud Charlet
charlet@adacore.com
Wed Aug 20 13:01:00 GMT 2008
This patch removes a spurious semantic error on the analysis of an extension
aggregate for a type that is derived from a private extension declared in a
parent unit.
The following must compile quietly:
package body X.Y.Z is
function Initialize return T_C is
begin
return T_C'(T_U with Size => 10, Value => 123);
end Initialize;
function Probe (Obj : T_C) return Integer is
begin
return Obj.Value;
end;
end X.Y.Z;
---
package X.Y.Z is
type T_C is new T_U (Size => 10) with record
Value : Integer;
end record;
function Initialize return T_C;
function Probe (Obj : T_C) return Integer;
end X.Y.Z;
---
package X.Y is
type T_U (Size : Natural) is abstract new T with private;
function Initialize return T_U is abstract;
private
type Data_Array is array (Natural range <>) of Natural;
type T_U (Size : Natural) is abstract new T with
record
Data : Data_Array (0 .. Size);
end record;
end X.Y;
--
package X is
type T (<>) is abstract tagged private;
function Initialize return T is abstract;
private
type T is abstract tagged null record;
end X;
Tested on i686-pc-linux-gnu, committed on trunk
2008-08-20 Ed Schonberg <schonberg@adacore.com>
* sem_aggr.adb, sem_type.adb, exp_ch9.ads, einfo.ads,
types.ads, exp_ch6.adb, exp_aggr.adb (Valid_Ancestor): Resolve
confusion between partial and full views of an ancestor of the context
type when the parent is a private extension declared in a parent unit,
and full views are available for the context type.
-------------- next part --------------
Index: sem_aggr.adb
===================================================================
--- sem_aggr.adb (revision 139262)
+++ sem_aggr.adb (working copy)
@@ -2155,20 +2155,31 @@
begin
Imm_Type := Base_Type (Typ);
- while Is_Derived_Type (Imm_Type)
- and then Etype (Imm_Type) /= Base_Type (A_Type)
- loop
- Imm_Type := Etype (Base_Type (Imm_Type));
+ while Is_Derived_Type (Imm_Type) loop
+ if Etype (Imm_Type) = Base_Type (A_Type) then
+ return True;
+
+ -- The base type of the parent type may appear as a private
+ -- extension if it is declared as such in a parent unit of
+ -- the current one. For consistency of the subsequent analysis
+ -- use the partial view for the ancestor part.
+
+ elsif Is_Private_Type (Etype (Imm_Type))
+ and then Present (Full_View (Etype (Imm_Type)))
+ and then Base_Type (A_Type) = Full_View (Etype (Imm_Type))
+ then
+ A_Type := Etype (Imm_Type);
+ return True;
+
+ else
+ Imm_Type := Etype (Base_Type (Imm_Type));
+ end if;
end loop;
- if not Is_Derived_Type (Base_Type (Typ))
- or else Etype (Imm_Type) /= Base_Type (A_Type)
- then
- Error_Msg_NE ("expect ancestor type of &", A, Typ);
- return False;
- else
- return True;
- end if;
+ -- If previous loop did not find a proper ancestor, report error.
+
+ Error_Msg_NE ("expect ancestor type of &", A, Typ);
+ return False;
end Valid_Ancestor_Type;
-- Start of processing for Resolve_Extension_Aggregate
Index: sem_type.adb
===================================================================
--- sem_type.adb (revision 139262)
+++ sem_type.adb (working copy)
@@ -884,8 +884,6 @@
then
return True;
- -- An aggregate is compatible with an array or record type
-
elsif T2 = Any_Composite
and then Ekind (T1) in E_Array_Type .. E_Record_Subtype
then
Index: exp_ch9.ads
===================================================================
--- exp_ch9.ads (revision 139262)
+++ exp_ch9.ads (working copy)
@@ -203,7 +203,9 @@
-- routine to make sure Complete_Master is called on exit).
procedure Expand_Access_Protected_Subprogram_Type (N : Node_Id);
- -- Build Equivalent_Type for an Access_to_protected_Subprogram
+ -- Build Equivalent_Type for an Access_To_Protected_Subprogram.
+ -- Equivalent_Type is a record type with two components: a pointer
+ -- to the protected object, and a pointer to the operation itself.
procedure Expand_Accept_Declarations (N : Node_Id; Ent : Entity_Id);
-- Expand declarations required for accept statement. See bodies of
Index: einfo.ads
===================================================================
--- einfo.ads (revision 139262)
+++ einfo.ads (working copy)
@@ -5016,6 +5016,7 @@
-- Generic_Renamings (Elist23) (for an instance)
-- Inner_Instances (Elist23) (generic function only)
-- Protection_Object (Node23) (for concurrent kind)
+ -- Spec_PPC_List (Node24)
-- Interface_Alias (Node25)
-- Overridden_Operation (Node26)
-- Wrapped_Entity (Node27) (non-generic case only)
Index: exp_ch6.adb
===================================================================
--- exp_ch6.adb (revision 139262)
+++ exp_ch6.adb (working copy)
@@ -4394,6 +4394,14 @@
Prot_Id : Entity_Id;
begin
+ -- If the subprogram is a function with an anonymous access
+ -- to protected subprogram, it must be expanded to create
+ -- its equivalent type.
+
+ -- if Ekind (Typ) = E_Anonymous_Access_Protected_Subprogram_Type then
+ -- Expand_Access_Protected_Subprogram_Type (N, Typ);
+ -- end if;
+
-- Deal with case of protected subprogram. Do not generate protected
-- operation if operation is flagged as eliminated.
Index: exp_aggr.adb
===================================================================
--- exp_aggr.adb (revision 139262)
+++ exp_aggr.adb (working copy)
@@ -2547,9 +2547,13 @@
-- in the limited case, the ancestor part must be either a
-- function call (possibly qualified, or wrapped in an unchecked
-- conversion) or aggregate (definitely qualified).
+ -- The ancestor part can also be a function call (that may be
+ -- transformed into an explicit dereference) or a qualification
+ -- of one such.
elsif Is_Limited_Type (Etype (A))
and then Nkind (Unqualify (A)) /= N_Function_Call -- aggregate?
+ and then Nkind (Unqualify (A)) /= N_Explicit_Dereference
and then
(Nkind (Unqualify (A)) /= N_Unchecked_Type_Conversion
or else
More information about the Gcc-patches
mailing list