This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.
Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
---|---|---|
Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |
Other format: | [Raw text] |
This patch modifies the generation of the Default_Initial_Condition procedure to disregard class-wide types and the underlying full views of private types. In addition, the patch preserves the attributes of freeze nodes when the partial and/or full views of a private type inherit the freeze node of the underlying full view. ------------ -- Source -- ------------ -- pack_1.ads package Pack_1 is type Untag_Par (Size : Natural) is private with Default_Initial_Condition => Is_OK_UP (Untag_Par); type Tag_Par (Size : Natural) is tagged private with Default_Initial_Condition => Is_OK_TP (Tag_Par); type Lim_Untag_Par (Size : Natural) is limited private with Default_Initial_Condition => Is_OK_LUP (Lim_Untag_Par); type Lim_Tag_Par (Size : Natural) is tagged limited private with Default_Initial_Condition => Is_OK_LTP (Lim_Tag_Par); function Is_OK_UP (Obj : Untag_Par) return Boolean; function Is_OK_TP (Obj : Tag_Par) return Boolean; function Is_OK_LUP (Obj : Lim_Untag_Par) return Boolean; function Is_OK_LTP (Obj : Lim_Tag_Par) return Boolean; private type Untag_Par (Size : Natural) is record Comp : Natural := Size; end record; type Tag_Par (Size : Natural) is tagged record Comp : Natural := Size; end record; type Lim_Untag_Par (Size : Natural) is limited record Comp : Natural := Size; end record; type Lim_Tag_par (Size : Natural) is tagged limited record Comp : Natural := Size; end record; end Pack_1; -- pack_1.adb with Ada.Text_IO; use Ada.Text_IO; package body Pack_1 is function Is_OK_UP (Obj : Untag_Par) return Boolean is begin Put_Line ("Untag_Par"); return True; end Is_OK_UP; function Is_OK_TP (Obj : Tag_Par) return Boolean is begin Put_Line ("Tag_Par"); return True; end Is_OK_TP; function Is_OK_LUP (Obj : Lim_Untag_Par) return Boolean is begin Put_Line ("Lim_Untag_Par"); return True; end Is_OK_LUP; function Is_OK_LTP (Obj : Lim_Tag_Par) return Boolean is begin Put_Line ("Lim_Tag_Par"); return True; end Is_OK_LTP; end Pack_1; -- pack_2.ads with Pack_1; use Pack_1; package Pack_2 is type Deriv_1 is private with Default_Initial_Condition => Is_OK_Deriv_1 (Deriv_1); type Deriv_2 is tagged private with Default_Initial_Condition => Is_OK_Deriv_2 (Deriv_2); type Deriv_3 is limited private with Default_Initial_Condition => Is_OK_Deriv_3 (Deriv_3); type Deriv_4 is tagged limited private with Default_Initial_Condition => Is_OK_Deriv_4 (Deriv_4); type Deriv_5 is private with Default_Initial_Condition; type Deriv_6 is tagged private with Default_Initial_Condition; type Deriv_7 is limited private with Default_Initial_Condition; type Deriv_8 is tagged limited private with Default_Initial_Condition; function Is_OK_Deriv_1 (Obj : Deriv_1) return Boolean; function Is_OK_Deriv_2 (Obj : Deriv_2) return Boolean; function Is_OK_Deriv_3 (Obj : Deriv_3) return Boolean; function Is_OK_Deriv_4 (Obj : Deriv_4) return Boolean; private type Deriv_1 is new Untag_Par (1); type Deriv_2 is new Tag_Par (2) with null record; type Deriv_3 is new Lim_Untag_Par (3); type Deriv_4 is new Lim_Tag_Par (4) with null record; type Deriv_5 is new Untag_Par (5); type Deriv_6 is new Tag_Par (6) with null record; type Deriv_7 is new Lim_Untag_Par (7); type Deriv_8 is new Lim_Tag_Par (8) with null record; end Pack_2; -- pack_2.adb with Ada.Text_IO; use Ada.Text_IO; package body Pack_2 is function Is_OK_Deriv_1 (Obj : Deriv_1) return Boolean is begin Put_Line ("Deriv_1"); return True; end Is_OK_Deriv_1; function Is_OK_Deriv_2 (Obj : Deriv_2) return Boolean is begin Put_Line ("Deriv_2"); return True; end Is_OK_Deriv_2; function Is_OK_Deriv_3 (Obj : Deriv_3) return Boolean is begin Put_Line ("Deriv_3"); return True; end Is_OK_Deriv_3; function Is_OK_Deriv_4 (Obj : Deriv_4) return Boolean is begin Put_Line ("Deriv_4"); return True; end Is_OK_Deriv_4; end Pack_2; -- main.adb with Pack_2; use Pack_2; procedure Main is Obj_1 : Deriv_1; Obj_2 : Deriv_2; Obj_3 : Deriv_3; Obj_4 : Deriv_4; Obj_5 : Deriv_5; Obj_6 : Deriv_6; Obj_7 : Deriv_7; Obj_8 : Deriv_8; begin null; end Main; ---------------------------- -- Compilation and output -- ---------------------------- $ gnatmake -q -gnata main.adb $ ./main Deriv_1 Deriv_2 Deriv_3 Deriv_4 Tested on x86_64-pc-linux-gnu, committed on trunk 2017-01-20 Hristian Kirtchev <kirtchev@adacore.com> * einfo.adb Flag298 now denotes Is_Underlying_Full_View. (Is_Underlying_Full_View): New routine. (Set_Is_Underlying_Full_View): New routine. (Write_Entity_Flags): Add an entry for Is_Underlying_Full_View. * einfo.ads Add new attribute Is_Underlying_Full_View. (Is_Underlying_Full_View): New routine along with pragma Inline. (Set_Is_Underlying_Full_View): New routine along with pragma Inline. * exp_util.adb (Build_DIC_Procedure_Body): Do not consider class-wide types and underlying full views. The first subtype is used as the working type for all Itypes, not just array base types. (Build_DIC_Procedure_Declaration): Do not consider class-wide types and underlying full views. The first subtype is used as the working type for all Itypes, not just array base types. * freeze.adb (Freeze_Entity): Inherit the freeze node of a full view or an underlying full view without clobbering the attributes of a previous freeze node. (Inherit_Freeze_Node): New routine. * sem_ch3.adb (Build_Derived_Private_Type): Mark an underlying full view as such. (Build_Underlying_Full_View): Mark an underlying full view as such. * sem_ch7.adb (Install_Private_Declarations): Mark an underlying full view as such.
Attachment:
difs
Description: Text document
Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
---|---|---|
Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |