[Ada] Dispatch tables for synchronized types

[Arnaud Charlet]

The dispatching structures for a synchronized tagged type are attached to the
corresponding record for the type. When building the dispatch tables for all
types in a package declaration, we exchange partial and full views of tagged
private types before building the tables. For a private type whose full view
is synchronized this must not be done. The tables will be constructed when the
separate declaration for the corresponding record is encountered.

See gnat.dg/sync1.ad[sb]

Tested on i686-pc-linux-gnu, committed on trunk

2008-05-27  Ed Schonberg  <schonberg@adacore.com>

	* exp_disp.adb (Build_Dispatch_Tables): For a private type completed by
	a synchronized tagged type, do not attempt to build dispatch table for
	full view. The table is built for the corresponding record type, which
	has its own declaration.

-------------- next part --------------
Index: exp_disp.adb
===================================================================
--- exp_disp.adb	(revision 135977)
+++ exp_disp.adb	(revision 135978)
@@ -173,25 +173,28 @@ package body Exp_Disp is
 
             --  Handle private types of library level tagged types. We must
             --  exchange the private and full-view to ensure the correct
-            --  expansion.
+            --  expansion. If the full view is a synchronized type ignore
+            --  the type because the table will be built for the corresponding
+            --  record type, that has its own declaration.
 
             elsif (Nkind (D) = N_Private_Type_Declaration
                      or else Nkind (D) = N_Private_Extension_Declaration)
                and then Present (Full_View (Defining_Entity (D)))
-               and then Is_Library_Level_Tagged_Type
-                          (Full_View (Defining_Entity (D)))
-               and then Ekind (Full_View (Defining_Entity (D)))
-                          /= E_Record_Subtype
             then
                declare
                   E1 : constant Entity_Id := Defining_Entity (D);
-                  E2 : constant Entity_Id := Full_View (Defining_Entity (D));
+                  E2 : constant Entity_Id := Full_View (E1);
 
                begin
-                  Exchange_Declarations (E1);
-                  Insert_List_After_And_Analyze (Last (Target_List),
-                    Make_DT (E1));
-                  Exchange_Declarations (E2);
+                  if Is_Library_Level_Tagged_Type (E2)
+                    and then Ekind (E2) /= E_Record_Subtype
+                    and then not Is_Concurrent_Type (E2)
+                  then
+                     Exchange_Declarations (E1);
+                     Insert_List_After_And_Analyze (Last (Target_List),
+                       Make_DT (E1));
+                     Exchange_Declarations (E2);
+                  end if;
                end;
             end if;