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

4 files changed, 36 insertions, 4 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index aa71397..87c3372 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index c25be53..c48b637 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 48bee0b..0e1af32 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 26b3df2..dfb0122 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,