Index: exp_intr.adb
===================================================================
--- exp_intr.adb	(revision 230223)
+++ exp_intr.adb	(working copy)
@@ -311,6 +311,31 @@
 
       Remove_Side_Effects (Tag_Arg);
 
+      --  Check that we have a proper tag
+
+      Insert_Action (N,
+        Make_Implicit_If_Statement (N,
+          Condition       => Make_Op_Eq (Loc,
+            Left_Opnd  => New_Copy_Tree (Tag_Arg),
+            Right_Opnd => New_Occurrence_Of (RTE (RE_No_Tag), Loc)),
+
+          Then_Statements => New_List (
+            Make_Raise_Statement (Loc,
+              New_Occurrence_Of (RTE (RE_Tag_Error), Loc)))));
+
+      --  Check that it is not the tag of an abstract type
+
+      Insert_Action (N,
+        Make_Implicit_If_Statement (N,
+          Condition       => Make_Function_Call (Loc,
+             Name                   =>
+               New_Occurrence_Of (RTE (RE_Type_Is_Abstract), Loc),
+             Parameter_Associations => New_List (New_Copy_Tree (Tag_Arg))),
+
+          Then_Statements => New_List (
+            Make_Raise_Statement (Loc,
+              New_Occurrence_Of (RTE (RE_Tag_Error), Loc)))));
+
       --  The subprogram is the third actual in the instantiation, and is
       --  retrieved from the corresponding renaming declaration. However,
       --  freeze nodes may appear before, so we retrieve the declaration
@@ -324,6 +349,22 @@
       Act_Constr := Entity (Name (Act_Rename));
       Result_Typ := Class_Wide_Type (Etype (Act_Constr));
 
+      --  Check that the accessibility level of the tag is no deeper than that
+      --  of the constructor function.
+
+      Insert_Action (N,
+        Make_Implicit_If_Statement (N,
+          Condition       =>
+            Make_Op_Gt (Loc,
+              Left_Opnd  =>
+                Build_Get_Access_Level (Loc, New_Copy_Tree (Tag_Arg)),
+              Right_Opnd =>
+                Make_Integer_Literal (Loc, Scope_Depth (Act_Constr))),
+
+          Then_Statements => New_List (
+            Make_Raise_Statement (Loc,
+              New_Occurrence_Of (RTE (RE_Tag_Error), Loc)))));
+
       if Is_Interface (Etype (Act_Constr)) then
 
          --  If the result type is not known to be a parent of Tag_Arg then we
@@ -390,7 +431,6 @@
       --  conversion of the call to the actual constructor.
 
       Rewrite (N, Convert_To (Result_Typ, Cnstr_Call));
-      Analyze_And_Resolve (N, Etype (Act_Constr));
 
       --  Do not generate a run-time check on the built object if tag
       --  checks are suppressed for the result type or tagged type expansion
@@ -458,6 +498,8 @@
                  Make_Raise_Statement (Loc,
                    Name => New_Occurrence_Of (RTE (RE_Tag_Error), Loc)))));
       end if;
+
+      Analyze_And_Resolve (N, Etype (Act_Constr));
    end Expand_Dispatching_Constructor_Call;
 
    ---------------------------
Index: rtsfind.ads
===================================================================
--- rtsfind.ads	(revision 230223)
+++ rtsfind.ads	(working copy)
@@ -640,6 +640,7 @@
      RE_Max_Predef_Prims,                -- Ada.Tags
      RE_Needs_Finalization,              -- Ada.Tags
      RE_No_Dispatch_Table_Wrapper,       -- Ada.Tags
+     RE_No_Tag,                          -- Ada.Tags
      RE_NDT_Prims_Ptr,                   -- Ada.Tags
      RE_NDT_TSD,                         -- Ada.Tags
      RE_Num_Prims,                       -- Ada.Tags
@@ -1871,6 +1872,7 @@
      RE_Max_Predef_Prims                 => Ada_Tags,
      RE_Needs_Finalization               => Ada_Tags,
      RE_No_Dispatch_Table_Wrapper        => Ada_Tags,
+     RE_No_Tag                           => Ada_Tags,
      RE_NDT_Prims_Ptr                    => Ada_Tags,
      RE_NDT_TSD                          => Ada_Tags,
      RE_Num_Prims                        => Ada_Tags,