sem_ch9.adb (Collect_Interfaces): Initialize Direct_Primitive_Operations for a tagged synchronized type...

2015-05-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch9.adb (Collect_Interfaces): Initialize
	Direct_Primitive_Operations for a tagged synchronized type,
	so it can used in ASIS mode.
	* sem_disp.adb (Check_Dispatching_Operation): If expansion is
	disabled, attach subprogram to list of Direct_Primitive_Operations
	of synchronized type itself, for ASIS use, because in this case
	Corresponding_Record_Type is not built.
	* einfo.ads: Indicate use of Direct_Primitive_Operations on
	synchronized type.

From-SVN: r223051
This commit is contained in:
Ed Schonberg 2015-05-12 09:20:50 +00:00 committed by Arnaud Charlet
parent 7c4d86c9cc
commit 27fd9ad83b
4 changed files with 36 additions and 4 deletions

View File

@ -1,3 +1,15 @@
2015-05-12 Ed Schonberg <schonberg@adacore.com>
* sem_ch9.adb (Collect_Interfaces): Initialize
Direct_Primitive_Operations for a tagged synchronized type,
so it can used in ASIS mode.
* sem_disp.adb (Check_Dispatching_Operation): If expansion is
disabled, attach subprogram to list of Direct_Primitive_Operations
of synchronized type itself, for ASIS use, because in this case
Corresponding_Record_Type is not built.
* einfo.ads: Indicate use of Direct_Primitive_Operations on
synchronized type.
2015-05-12 Pierre-Marie de Rodat <derodat@adacore.com>
* exp_pakd.adb: Make clearer the comment in exp_pakd.adb about

View File

@ -765,11 +765,13 @@ package Einfo is
-- Default_Aspect_Component_Value (Node19) [base type only]
-- Defined in array types. Holds the static value specified in a
-- Default_Component_Value aspect specification for the array type.
-- Default_Component_Value aspect specification for the array type,
-- or inherited on derivation.
-- Default_Aspect_Value (Node19) [base type only]
-- Defined in scalar types. Holds the static value specified in a
-- Default_Value aspect specification for the type.
-- Default_Value aspect specification for the type, or inherited
-- on derivation.
-- Default_Expr_Function (Node21)
-- Defined in parameters. It holds the entity of the parameterless
@ -880,6 +882,9 @@ package Einfo is
-- primitives that come from source must be stored in this list in the
-- order of their occurrence in the sources. For incomplete types the
-- list is always empty.
-- When expansion is disabled the corresponding record type of a
-- synchronized type is not constructed. In that case, such types
-- carry this attribute directly, for ASIS use.
-- Directly_Designated_Type (Node20)
-- Defined in access types. This field points to the type that is
@ -1501,8 +1506,11 @@ package Einfo is
-- Has_Default_Aspect (Flag39) [base type only]
-- Defined in entities for types and subtypes, set for scalar types with
-- a Default_Value aspect and array types with a Default_Component_Value
-- apsect. If this flag is set, then a corresponding aspect specification
-- node will be present on the rep item chain for the entity.
-- aspect. If this flag is set, then a corresponding aspect specification
-- node will be present on the rep item chain for the entity. For a
-- derived type that inherits a default from its ancestor, the default
-- value is set, but it may be overridden by an aspect declaration on
-- type type derivation.
-- Has_Default_Init_Cond (Flag3)
-- Defined in type and subtype entities. Set if pragma Default_Initial_

View File

@ -3225,6 +3225,13 @@ package body Sem_Ch9 is
if Present (Interface_List (N)) then
Set_Is_Tagged_Type (T);
-- The primitive operations of a tagged synchronized type are
-- placed on the Corresponding_Record for proper dispatching,
-- but are attached to the synchronized type itself when
-- expansion is disabled, for ASIS use.
Set_Direct_Primitive_Operations (T, New_Elmt_List);
Iface := First (Interface_List (N));
while Present (Iface) loop
Iface_Typ := Find_Type_Of_Subtype_Indic (Iface);

View File

@ -1334,6 +1334,11 @@ package body Sem_Disp is
elsif Is_Concurrent_Type (Tagged_Type) then
pragma Assert (not Expander_Active);
-- Attach operation to list of primitives of the synchronized
-- type itself, for ASIS use.
Append_Elmt (Subp, Direct_Primitive_Operations (Tagged_Type));
null;
-- If no old subprogram, then we add this as a dispatching operation,