From 27fd9ad83b56a6cb256bae3a1c6524afb624d209 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Tue, 12 May 2015 09:20:50 +0000 Subject: [PATCH] sem_ch9.adb (Collect_Interfaces): Initialize Direct_Primitive_Operations for a tagged synchronized type... 2015-05-12 Ed Schonberg * 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 --- gcc/ada/ChangeLog | 12 ++++++++++++ gcc/ada/einfo.ads | 16 ++++++++++++---- gcc/ada/sem_ch9.adb | 7 +++++++ gcc/ada/sem_disp.adb | 5 +++++ 4 files changed, 36 insertions(+), 4 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index aa71397e3b1..87c3372e997 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2015-05-12 Ed Schonberg + + * 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 * exp_pakd.adb: Make clearer the comment in exp_pakd.adb about diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index c25be530525..c48b63759e9 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -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_ diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index 48bee0b938d..0e1af32c678 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -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); diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index 26b3df25289..dfb01226019 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -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, -- 2.11.4.GIT