2004-08-09 Thomas Quinot <quinot@act-europe.fr>

	* g-socket.adb (Abort_Selector): Initialize Buf to prevent valgrind
	from complaining on potential uninitialized reference.
	Change calls to GNAT.Sockets.Thin.Is_Socket_In_Set to account for
	new specification and test explicitly for non-zero return value.

	* g-socthi.ads (Is_Socket_In_Set): Declare imported function as
	returning C.int, to avoid using a derived boolean type.

	* exp_ch5.adb (Make_Tag_Ctrl_Assignments): Use
	Duplicate_Subexpr_No_Checks in preference to direct use of
	Remove_Side_Effects and New_Copy_Tree.
	Clear Comes_From_Source on prefix of 'Size attribute reference.

	* g-socthi.adb, g-socthi-vms.adb, g-socthi-mingw.adb,
	g-socthi-vxworks.adb: Change calls to
	GNAT.Sockets.Thin.Is_Socket_In_Set to account for new specification
	and test explicitly for non-zero return value.

	* g-socthi-vms.ads, g-socthi-mingw.ads, g-socthi-vxworks.ads:
	(Is_Socket_In_Set): Declare imported function as returning C.int, to
	avoid using a derived boolean type.

2004-08-09  Albert Lee  <lee@gnat.com>

	* system-irix-n32.ads: Refine tasking priority constants for IRIX.

2004-08-09  Pascal Obry  <obry@gnat.com>

	* gnat_ugn.texi: Document new way to build DLLs on Windows using
	GCC's -shared option.

	* mlib-tgt-mingw.adb (Build_Dynamic_Library): Pass GCC's options into
	Options_2 parameter (options put after object files).

2004-08-09  Olivier Hainque  <hainque@act-europe.fr>

	* decl.c (gnat_to_gnu_entity) <E_Array_Subtype>: Adjust condition to
	ignore overflows on low and high bounds of an index to also account for
	differences in signedness between sizetype and gnu_index_subtype.
	These are as legitimate as the ones caused by a lower TYPE_PRECISION
	on sizetype.

2004-08-09  Robert Dewar  <dewar@gnat.com>

	* s-solita.ads, s-solita.adb: Minor reformatting

	* gnat_rm.texi: Add documentation for pragma Profile (Restricted)
	Move pragma Restricted_Run_Time, No_Run_Time, Ravenscar to new
	obsolescent section
	Add note that No_Implicit_Conditionals does not suppress
	run time constraint checks.

	* vms_conv.ads: Minor reformatting

	* s-secsta.adb: Use SS_Ptr instead of Mark_Id as stack pointer (cleanup
	and necessary for following change).
	(Mark): Return new format Mark_Id containing sec stack address
	(Release): Use sec stack address from Mark_Id avoiding Self call

	* s-secsta.ads: Define SS_Ptr to be used instead of Mark_Id as stack
	pointer (cleanup and necessary for following change).
	Define Mark_Id as record containing address of secondary stack, that way
	Release does not need to find the stack again, decreasing the number of
	calls to Self and improving efficiency.

	* sem_util.ads: Add a ??? comment for Is_Local_Variable_Reference

	* sem_ch5.adb (Analyze_Case_Statement): Add circuitry to track value of
	case variable into the individual case branches when possible.

	* sem_ch11.adb: Minor reformatting

	* prj.ads: Correct spelling of suffixs

	* prj-nmsc.adb: Minor reformatting
	Correct spelling suffixs throughout (also in identifiers)

	* freeze.adb: Minor spelling correction

	* exp_ch2.adb: Cleanups to handling of Current_Value
	(no functional effect).

	* bld.adb: Correct spelling of suffixs

	* einfo.adb (Enclosing_Dynamic_Scope): Defend against junk argument

2004-08-09  Ed Schonberg  <schonberg@gnat.com>

	PR ada/15408

	* sem_ch7.adb (Install_Private_Declarations): In the body of the
	package or of a child, private entities are both immediately_visible
	and not hidden.

2004-08-09  Ed Schonberg  <schonberg@gnat.com>

	* sem_eval.adb (Eval_Integer_Literal): If the context is Any_Integer,
	there are no range checks on the value of the literal.

	* exp_ch7.adb (Insert_Actions_In_Scope_Around): If the node being
	wrapped is the triggering alternative of an asynchronous select, action
	statements mustbe inserted before the select itself.

	* sem_attr.adb (Analyze_Attribute, case 'Size): Handle properly the
	case where the prefix is a protected function call.
	(Resolve_Attribute, case 'Access): The attribute reference on a
	subprogram is legal in a generic body if the subprogram is declared
	elsewhere.

2004-08-09  Vincent Celier  <celier@gnat.com>

	* makegpr.adb (Build_Library): Link with g++ if C++ is one of the
	languages, otherwise building the library may fail with unresolved
	symbols.
	(Compile_Sources): Do not build libraries if -c switch is used

	* gnatlink.adb (Process_Args): New switches -M and -Mmap
	(Write_Usage): If map file creation is supported, output new switches
	-M and -Mmap.
	(Gnatlink): When -M is specified, add the necessary switch(es) to the
	gcc call, when supported.

	* Makefile.in: Added indepsw.o to the object list for gnatlink
	Specified the AIX, GNU/Linux and Windows versions of indepsw.adb

	* indepsw-aix.adb, indepsw-linux.adb, indepsw-mingw.adb,
	indepsw.adb, indepsw.ads: New files.

2004-08-09  Bernard Banner  <banner@gnat.com>

	* system-vxworks-x86.ads, s-vxwork-x86.ads: New files.

	* Makefile.in: add section for vxworks x86

2004-08-09  Hristian Kirtchev  <kirtchev@gnat.com>

	* exp_ch3.adb (Build_Init_Statements): Add extra condition to deal with
	per-object constrained components where the discriminant is of an
	Access type.
	(Build_Record_Init_Proc): Add condition to prevent the inheritance of
	the parent initialization procedure for derived Unchecked_Unions.
	Instead, derived Unchecked_Unions build their own initialization
	procedure.
	(Build_Variant_Record_Equality): Implement Unchecked_Union equality.
	Check the body of the subprogram for details.
	(Freeze_Record_Type): Prevent the inheritance of discriminant checking
	functions for derived Unchecked_Union types by introducing a condition.
	Allow the creation of TSS equality functions for Unchecked_Unions.
	(Make_Eq_Case): Rename formal parameter Node to E in function signature.
	Add formal parameter Discr to function signature. Discr is used to
	control the generated case statement for Unchecked_Union types.
	(Make_Eq_If): Rename formal parameter Node to E in function signature.

	* exp_ch4.adb (Build_Equality_Call): Implement equality calls for
	Unchecked_Unions.
	Check the body of the subprogram for details.
	(Expand_Composite_Equality): Augment composite type equality to include
	correct handling of Unchecked_Union components.
	(Expand_N_In): Add condition to detect illegal membership tests when the
	subtype mark is a constrained Unchecked_Union and the expression lacks
	inferable discriminants, and build a Raise_Program_Error node.
	(Expand_N_Op_Eq): Add function Has_Unconstrained_UU_Component. Used
	to detect types that contain components of unconstrained Unchecked_Union
	subtype. Add condition to detect equality between types that have an
	unconstrained Unchecked_Union component, and build a Raise_Program_Error
	node. Add condition to detect equality between Unchecked_Union types
	that lack inferable discriminants, and build a Raise_Program_Error node.
	Otherwise build a TSS equality function call.
	(Expand_N_Type_Conversion): Add condition to detect illegal conversions
	from a derived Unchecked_Union to an unconstrained non-Unchecked_Union
	with the operand lacking inferable discriminants, and build a Raise_
	Program_Error node.
	(Expand_Record_Equality): Remove guard that prevents Unchecked_Union
	composite equality.
	(Has_Inferable_Discriminants): Implement new predicate for objects and
	expressions of Unchecked_Union type. Check the body of subprogram for
	details.
	(Has_Unconstrained_UU_Components): Add function
	Component_Is_Unconstrained_UU. It is used to detect whether a single
	component is of an unconstrained Unchecked_Union subtype. Add function
	Variant_Is_Unconstrained_UU. It is used to detect whether a single
	component inside a variant is of an unconstrained Unchecked_Union type.

	* exp_ch5.adb (Expand_Assign_Record): Add condition to copy the
	inferred discriminant values. Add condition to generate a case
	statement with an inferred discriminant as the switch.
	(Make_Component_List_Assign): Introduce a Boolean flag that determines
	the behaviour of the subprogram in the presence of an Unchecked_Union.
	Add condition to trigger the usage of the inferred discriminant value
	as the generated case statement switch.
	(Make_Field_Assign): Introduce a Boolean flag that determines the
	behaviour of the subprogram in the presence of an Unchecked_Union. Add
	condition to trigger the usage of the inferred discriminant value as
	the right-hand side of the generated assignment.

	* exp_ch6.adb (Expand_Call): Add condition to skip extra actual
	parameter generation when dealing with Unchecked_Unions.

	* checks.adb (Apply_Discriminant_Check): Do not apply discriminant
	checks for Unchecked_Unions.

	* einfo.ads: Update comment on usage of flag Has_Per_Object_Constraint

	* exp_attr.adb (Expand_N_Attribute_Reference): Produce
	Raise_Program_Error nodes for the execution of Read and Write
	attributes of Unchecked_Union types and the execution of Input and
	Output attributes of Unchecked_Union types that lack default
	discriminant values.

	* sem_prag.adb (Analyze_Pragma): Remodel the analysis of pragma
	Unchecked_Union. Add procedure Check_Component. It is used to inspect
	per-object constrained components of Unchecked_Unions for being
	Unchecked_Unions themselves. Add procedure Check_Variant. It is used to
	check individual components withing a variant.

	* sem_res.adb (Resolve_Comparison_Op): Remove guard that prevents
	comparison of Unchecked_Unions.
	(Resolve_Equality_OP): Remove guard that prevents equality between
	Unchecked_Unions.

	* sem_util.adb (Build_Component_Subtype): Add guard to prevent creation
	of component subtypes for Unchecked_Union components.
	(Get_Actual_Subtype): Add condition that returs the Unchecked_Union type
	since it is the actual subtype.

	* sem_ch12.adb (Instantiate_Type): Add condition to detect the correct
	pass of Unchecked_Union subtypes as generic actuals to formal types
	that lack known_discriminant_parts or that are derived Unchecked_Union
	types, and do nothing. In any other case, produce an error message.

	* sem_ch3.adb (Analyze_Component_Declaration): Add function
	Contains_POC. It determines whether a constraint uses the discriminant
	of an enclosing record type.
	Add condition to detect per-object constrained component and set the
	appropriate flag.
	(Derived_Type_Declaration): Remove guard that prevents derivation from
	Unchecked_Union types.
	(Process_Subtype): Remove quard that prevents the creation of Unchecked_
	Union subtypes.

	* sem_ch4.adb (Analyze_Selected_Component): Correct the detection of
	references to Unchecked_Union discriminants.

	* sem_ch6.adb (Create_Extra_Formals): Add condition to skip extra
	formal generation when dealing with Unchecked_Unions.
	(Set_Actual_Subtypes): Add condition to prevent generation of actual
	subtypes for Unchecked_Unions.

	* sem_ch7.adb (Analyze_Package_Specification): Add procedure
	Inspect_Unchecked_Union_Completion. It is used to detect incorrect
	completions of discriminated partial views by Unchecked_Unions and
	produce an error message.

2004-08-09  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>

	* trans.c (struct stmt_group): New field, GLOBAL.
	(global_stmt_group, gnu_elab_proc_decl, build_unit_elab): Deleted.
	(struct elab_info): New struct.
	(elab_info_list, gnu_elab_proc_stack): New variables.
	(Compilation_Unit_to_gnu): New procedure.
	(gigi): Call it and also handle elaboration procs we've saved.
	(gnat_init_stmt_group): Don't set global_stmt_group; instead initialize
	global field from parent.
	(gnat_to_gnu): Get decl from gnu_elab_proc_stack.
	(gnat_to_gnu, case N_Compilation_Unit): Call Compilation_Unit_to_gnu.
	(start_stmt_group): Initialize global field from parent.
	(add_decl_expr): Set to global for current statement group.
	(gnat_gimplify_expr, case NULL_EXPR): Add operand 0 to pre list, not
	post.

	* utils.c (global_bindings_p): True when no current_function_decl; no
	longer check current_binding_level.

2004-08-09  Ben Brosgol  <brosgol@gnat.com>

	* xgnatugn.adb: Added logic to deal with @ifset/@ifclear for edition
	choice.

	* gnat_rm.texi, gnat_ugn.texi: Added edition conditionalization logic.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@85714 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 614 insertions, 30 deletions

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index d1a7bbcd803..7f57b02425c 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -47,6 +47,7 @@ with Opt;      use Opt;
 with Rtsfind;  use Rtsfind;
 with Sem;      use Sem;
 with Sem_Cat;  use Sem_Cat;
+with Sem_Ch3;  use Sem_Ch3;
 with Sem_Ch13; use Sem_Ch13;
 with Sem_Eval; use Sem_Eval;
 with Sem_Res;  use Sem_Res;
@@ -154,6 +155,17 @@ package body Exp_Ch4 is
    --  for created object. If context is an access parameter, create a
    --  local access type to have a usable finalization list.
 
+   function Has_Inferable_Discriminants (N : Node_Id) return Boolean;
+   --  Ada 2005 (AI-216): A view of an Unchecked_Union object has inferable
+   --  discriminants if it has a constrained nominal type, unless the object
+   --  is a component of an enclosing Unchecked_Union object that is subject
+   --  to a per-object constraint and the enclosing object lacks inferable
+   --  discriminants.
+   --
+   --  An expression of an Unchecked_Union type has inferable discriminants
+   --  if it is either a name of an object with inferable discriminants or a
+   --  qualified expression whose subtype mark denotes a constrained subtype.
+
    procedure Insert_Dereference_Action (N : Node_Id);
    --  N is an expression whose type is an access. When the type of the
    --  associated storage pool is derived from Checked_Pool, generate a
@@ -1581,6 +1593,123 @@ package body Exp_Ch4 is
                end;
 
             else
+               --  Comparison between Unchecked_Union components
+
+               if Is_Unchecked_Union (Full_Type) then
+                  declare
+                     Lhs_Type      : Node_Id := Full_Type;
+                     Rhs_Type      : Node_Id := Full_Type;
+                     Lhs_Discr_Val : Node_Id;
+                     Rhs_Discr_Val : Node_Id;
+
+                  begin
+                     --  Lhs subtype
+
+                     if Nkind (Lhs) = N_Selected_Component then
+                        Lhs_Type := Etype (Entity (Selector_Name (Lhs)));
+                     end if;
+
+                     --  Rhs subtype
+
+                     if Nkind (Rhs) = N_Selected_Component then
+                        Rhs_Type := Etype (Entity (Selector_Name (Rhs)));
+                     end if;
+
+                     --  Lhs of the composite equality
+
+                     if Is_Constrained (Lhs_Type) then
+
+                        --  Since the enclosing record can never be an
+                        --  Unchecked_Union (this code is executed for records
+                        --  that do not have variants), we may reference its
+                        --  discriminant(s).
+
+                        if Nkind (Lhs) = N_Selected_Component
+                          and then Has_Per_Object_Constraint (
+                                     Entity (Selector_Name (Lhs)))
+                        then
+                           Lhs_Discr_Val :=
+                             Make_Selected_Component (Loc,
+                               Prefix => Prefix (Lhs),
+                               Selector_Name =>
+                                 New_Copy (
+                                   Get_Discriminant_Value (
+                                     First_Discriminant (Lhs_Type),
+                                     Lhs_Type,
+                                     Stored_Constraint (Lhs_Type))));
+
+                        else
+                           Lhs_Discr_Val := New_Copy (
+                             Get_Discriminant_Value (
+                               First_Discriminant (Lhs_Type),
+                               Lhs_Type,
+                               Stored_Constraint (Lhs_Type)));
+
+                        end if;
+                     else
+                        --  It is not possible to infer the discriminant since
+                        --  the subtype is not constrained.
+
+                        Insert_Action (Nod,
+                          Make_Raise_Program_Error (Loc,
+                            Reason => PE_Unchecked_Union_Restriction));
+
+                        --  Prevent Gigi from generating illegal code, change
+                        --  the equality to a standard False.
+
+                        return New_Occurrence_Of (Standard_False, Loc);
+                     end if;
+
+                     --  Rhs of the composite equality
+
+                     if Is_Constrained (Rhs_Type) then
+                        if Nkind (Rhs) = N_Selected_Component
+                          and then Has_Per_Object_Constraint (
+                                     Entity (Selector_Name (Rhs)))
+                        then
+                           Rhs_Discr_Val :=
+                             Make_Selected_Component (Loc,
+                               Prefix => Prefix (Rhs),
+                               Selector_Name =>
+                                 New_Copy (
+                                   Get_Discriminant_Value (
+                                     First_Discriminant (Rhs_Type),
+                                     Rhs_Type,
+                                     Stored_Constraint (Rhs_Type))));
+
+                        else
+                           Rhs_Discr_Val := New_Copy (
+                             Get_Discriminant_Value (
+                               First_Discriminant (Rhs_Type),
+                               Rhs_Type,
+                               Stored_Constraint (Rhs_Type)));
+
+                        end if;
+                     else
+                        Insert_Action (Nod,
+                          Make_Raise_Program_Error (Loc,
+                            Reason => PE_Unchecked_Union_Restriction));
+
+                        return Empty;
+                     end if;
+
+                     --  Call the TSS equality function with the inferred
+                     --  discriminant values.
+
+                     return
+                       Make_Function_Call (Loc,
+                         Name => New_Reference_To (Eq_Op, Loc),
+                         Parameter_Associations => New_List (
+                           Lhs,
+                           Rhs,
+                           Lhs_Discr_Val,
+                           Rhs_Discr_Val));
+                  end;
+               end if;
+
+               --  Shouldn't this be an else, we can't fall through
+               --  the above IF, right???
+
                return
                  Make_Function_Call (Loc,
                    Name => New_Reference_To (Eq_Op, Loc),
@@ -2963,6 +3092,27 @@ package body Exp_Ch4 is
                        Prefix => New_Reference_To (Typ, Loc))));
                Analyze_And_Resolve (N, Rtyp);
                return;
+
+            --  Ada 2005 (AI-216): Program_Error is raised when evaluating
+            --  a membership test if the subtype mark denotes a constrained
+            --  Unchecked_Union subtype and the expression lacks inferable
+            --  discriminants.
+
+            elsif Is_Unchecked_Union (Base_Type (Typ))
+              and then Is_Constrained (Typ)
+              and then not Has_Inferable_Discriminants (Lop)
+            then
+               Insert_Action (N,
+                 Make_Raise_Program_Error (Loc,
+                   Reason => PE_Unchecked_Union_Restriction));
+
+               --  Prevent Gigi from generating incorrect code by rewriting
+               --  the test as a standard False.
+
+               Rewrite (N,
+                 New_Occurrence_Of (Standard_False, Loc));
+
+               return;
             end if;
 
             --  Here we have a non-scalar type
@@ -3714,6 +3864,10 @@ package body Exp_Ch4 is
       --  build and analyze call, adding conversions if the operation is
       --  inherited.
 
+      function Has_Unconstrained_UU_Component (Typ : Node_Id) return Boolean;
+      --  Determines whether a type has a subcompoment of an unconstrained
+      --  Unchecked_Union subtype. Typ is a record type.
+
       -------------------------
       -- Build_Equality_Call --
       -------------------------
@@ -3731,14 +3885,315 @@ package body Exp_Ch4 is
             R_Exp := OK_Convert_To (Op_Type, R_Exp);
          end if;
 
-         Rewrite (N,
-           Make_Function_Call (Loc,
-             Name => New_Reference_To (Eq, Loc),
-             Parameter_Associations => New_List (L_Exp, R_Exp)));
+         --  If we have an Unchecked_Union, we need to add the inferred
+         --  discriminant values as actuals in the function call. At this
+         --  point, the expansion has determined that both operands have
+         --  inferable discriminants.
+
+         if Is_Unchecked_Union (Op_Type) then
+            declare
+               Lhs_Type      : constant Node_Id := Etype (L_Exp);
+               Rhs_Type      : constant Node_Id := Etype (R_Exp);
+               Lhs_Discr_Val : Node_Id;
+               Rhs_Discr_Val : Node_Id;
+
+            begin
+               --  Per-object constrained selected components require special
+               --  attention. If the enclosing scope of the component is an
+               --  Unchecked_Union, we can not reference its discriminants
+               --  directly. This is why we use the two extra parameters of
+               --  the equality function of the enclosing Unchecked_Union.
+
+               --  type UU_Type (Discr : Integer := 0) is
+               --     . . .
+               --  end record;
+               --  pragma Unchecked_Union (UU_Type);
+
+               --  1. Unchecked_Union enclosing record:
+
+               --     type Enclosing_UU_Type (Discr : Integer := 0) is record
+               --        . . .
+               --        Comp : UU_Type (Discr);
+               --        . . .
+               --     end Enclosing_UU_Type;
+               --     pragma Unchecked_Union (Enclosing_UU_Type);
+
+               --     Obj1 : Enclosing_UU_Type;
+               --     Obj2 : Enclosing_UU_Type (1);
+
+               --     . . . Obj1 = Obj2 . . .
+
+               --     Generated code:
+
+               --     if not (uu_typeEQ (obj1.comp, obj2.comp, a, b)) then
+
+               --  A and B are the formal parameters of the equality function
+               --  of Enclosing_UU_Type. The function always has two extra
+               --  formals to capture the inferred discriminant values.
+
+               --  2. Non-Unchecked_Union enclosing record:
+
+               --     type
+               --       Enclosing_Non_UU_Type (Discr : Integer := 0)
+               --     is record
+               --        . . .
+               --        Comp : UU_Type (Discr);
+               --        . . .
+               --     end Enclosing_Non_UU_Type;
+
+               --     Obj1 : Enclosing_Non_UU_Type;
+               --     Obj2 : Enclosing_Non_UU_Type (1);
+
+               --     . . . Obj1 = Obj2 . . .
+
+               --     Generated code:
+
+               --     if not (uu_typeEQ (obj1.comp, obj2.comp,
+               --                        obj1.discr, obj2.discr)) then
+
+               --  In this case we can directly reference the discriminants of
+               --  the enclosing record.
+
+               --  Lhs of equality
+
+               if Nkind (Lhs) = N_Selected_Component
+                 and then Has_Per_Object_Constraint (
+                            Entity (Selector_Name (Lhs)))
+               then
+                  --  Enclosing record is an Unchecked_Union, use formal A
+
+                  if Is_Unchecked_Union (Scope
+                       (Entity (Selector_Name (Lhs))))
+                  then
+                     Lhs_Discr_Val :=
+                       Make_Identifier (Loc,
+                         Chars => Name_A);
+
+                  --  Enclosing record is of a non-Unchecked_Union type, it is
+                  --  possible to reference the discriminant.
+
+                  else
+                     Lhs_Discr_Val :=
+                       Make_Selected_Component (Loc,
+                         Prefix => Prefix (Lhs),
+                         Selector_Name =>
+                           New_Copy (Get_Discriminant_Value (
+                             First_Discriminant (Lhs_Type),
+                             Lhs_Type,
+                             Stored_Constraint (Lhs_Type))));
+
+                  end if;
+
+               --  Comment needed here ???
+
+               else
+                  --  Infer the discriminant value
+
+                  Lhs_Discr_Val :=
+                    New_Copy (Get_Discriminant_Value (
+                      First_Discriminant (Lhs_Type),
+                      Lhs_Type,
+                      Stored_Constraint (Lhs_Type)));
+
+               end if;
+
+               --  Rhs of equality
+
+               if Nkind (Rhs) = N_Selected_Component
+                  and then Has_Per_Object_Constraint (
+                             Entity (Selector_Name (Rhs)))
+               then
+                  if Is_Unchecked_Union (Scope
+                       (Entity (Selector_Name (Rhs))))
+                  then
+                     Rhs_Discr_Val :=
+                       Make_Identifier (Loc,
+                         Chars => Name_B);
+
+                  else
+                     Rhs_Discr_Val :=
+                       Make_Selected_Component (Loc,
+                         Prefix => Prefix (Rhs),
+                         Selector_Name =>
+                           New_Copy (Get_Discriminant_Value (
+                             First_Discriminant (Rhs_Type),
+                             Rhs_Type,
+                             Stored_Constraint (Rhs_Type))));
+
+                  end if;
+               else
+                  Rhs_Discr_Val :=
+                    New_Copy (Get_Discriminant_Value (
+                      First_Discriminant (Rhs_Type),
+                      Rhs_Type,
+                      Stored_Constraint (Rhs_Type)));
+
+               end if;
+
+               Rewrite (N,
+                 Make_Function_Call (Loc,
+                   Name => New_Reference_To (Eq, Loc),
+                   Parameter_Associations => New_List (
+                     L_Exp,
+                     R_Exp,
+                     Lhs_Discr_Val,
+                     Rhs_Discr_Val)));
+            end;
+
+         --  Normal case, not an unchecked union
+
+         else
+            Rewrite (N,
+              Make_Function_Call (Loc,
+                Name => New_Reference_To (Eq, Loc),
+                Parameter_Associations => New_List (L_Exp, R_Exp)));
+         end if;
 
          Analyze_And_Resolve (N, Standard_Boolean, Suppress => All_Checks);
       end Build_Equality_Call;
 
+      ------------------------------------
+      -- Has_Unconstrained_UU_Component --
+      ------------------------------------
+
+      function Has_Unconstrained_UU_Component
+        (Typ : Node_Id) return Boolean
+      is
+         Tdef  : constant Node_Id :=
+                   Type_Definition (Declaration_Node (Typ));
+         Clist : Node_Id;
+         Vpart : Node_Id;
+
+         function Component_Is_Unconstrained_UU
+           (Comp : Node_Id) return Boolean;
+         --  Determines whether the subtype of the component is an
+         --  unconstrained Unchecked_Union.
+
+         function Variant_Is_Unconstrained_UU
+           (Variant : Node_Id) return Boolean;
+         --  Determines whether a component of the variant has an unconstrained
+         --  Unchecked_Union subtype.
+
+         -----------------------------------
+         -- Component_Is_Unconstrained_UU --
+         -----------------------------------
+
+         function Component_Is_Unconstrained_UU
+           (Comp : Node_Id) return Boolean
+         is
+         begin
+            if Nkind (Comp) /= N_Component_Declaration then
+               return False;
+            end if;
+
+            declare
+               Sindic : constant Node_Id :=
+                          Subtype_Indication (Component_Definition (Comp));
+
+            begin
+               --  Unconstrained nominal type. In the case of a constraint
+               --  present, the node kind would have been N_Subtype_Indication.
+
+               if Nkind (Sindic) = N_Identifier then
+                  return Is_Unchecked_Union (Base_Type (Etype (Sindic)));
+               end if;
+
+               return False;
+            end;
+         end Component_Is_Unconstrained_UU;
+
+         ---------------------------------
+         -- Variant_Is_Unconstrained_UU --
+         ---------------------------------
+
+         function Variant_Is_Unconstrained_UU
+           (Variant : Node_Id) return Boolean
+         is
+            Clist : constant Node_Id := Component_List (Variant);
+
+         begin
+            if Is_Empty_List (Component_Items (Clist)) then
+               return False;
+            end if;
+
+            declare
+               Comp : Node_Id := First (Component_Items (Clist));
+
+            begin
+               while Present (Comp) loop
+
+                  --  One component is sufficent
+
+                  if Component_Is_Unconstrained_UU (Comp) then
+                     return True;
+                  end if;
+
+                  Next (Comp);
+               end loop;
+            end;
+
+            --  None of the components withing the variant were of
+            --  unconstrained Unchecked_Union type.
+
+            return False;
+         end Variant_Is_Unconstrained_UU;
+
+      --  Start of processing for Has_Unconstrained_UU_Component
+
+      begin
+         if Null_Present (Tdef) then
+            return False;
+         end if;
+
+         Clist := Component_List (Tdef);
+         Vpart := Variant_Part (Clist);
+
+         --  Inspect available components
+
+         if Present (Component_Items (Clist)) then
+            declare
+               Comp : Node_Id := First (Component_Items (Clist));
+
+            begin
+               while Present (Comp) loop
+
+                  --  One component is sufficent
+
+                  if Component_Is_Unconstrained_UU (Comp) then
+                     return True;
+                  end if;
+
+                  Next (Comp);
+               end loop;
+            end;
+         end if;
+
+         --  Inspect available components withing variants
+
+         if Present (Vpart) then
+            declare
+               Variant : Node_Id := First (Variants (Vpart));
+
+            begin
+               while Present (Variant) loop
+
+                  --  One component within a variant is sufficent
+
+                  if Variant_Is_Unconstrained_UU (Variant) then
+                     return True;
+                  end if;
+
+                  Next (Variant);
+               end loop;
+            end;
+         end if;
+
+         --  Neither the available components, nor the components inside the
+         --  variant parts were of an unconstrained Unchecked_Union subtype.
+
+         return False;
+      end Has_Unconstrained_UU_Component;
+
    --  Start of processing for Expand_N_Op_Eq
 
    begin
@@ -3899,6 +4354,50 @@ package body Exp_Ch4 is
 
             Build_Equality_Call (Op_Name);
 
+         --  Ada 2005 (AI-216): Program_Error is raised when evaluating the
+         --  predefined equality operator for a type which has a subcomponent
+         --  of an Unchecked_Union type whose nominal subtype is unconstrained.
+
+         elsif Has_Unconstrained_UU_Component (Typl) then
+            Insert_Action (N,
+              Make_Raise_Program_Error (Loc,
+                Reason => PE_Unchecked_Union_Restriction));
+
+            --  Prevent Gigi from generating incorrect code by rewriting the
+            --  equality as a standard False.
+
+            Rewrite (N,
+              New_Occurrence_Of (Standard_False, Loc));
+
+         elsif Is_Unchecked_Union (Typl) then
+
+            --  If we can infer the discriminants of the operands, we make a
+            --  call to the TSS equality function.
+
+            if Has_Inferable_Discriminants (Lhs)
+                 and then
+               Has_Inferable_Discriminants (Rhs)
+            then
+               Build_Equality_Call
+                 (TSS (Root_Type (Typl), TSS_Composite_Equality));
+
+            else
+               --  Ada 2005 (AI-216): Program_Error is raised when evaluating
+               --  the predefined equality operator for an Unchecked_Union type
+               --  if either of the operands lack inferable discriminants.
+
+               Insert_Action (N,
+                 Make_Raise_Program_Error (Loc,
+                   Reason => PE_Unchecked_Union_Restriction));
+
+               --  Prevent Gigi from generating incorrect code by rewriting
+               --  the equality as a standard False.
+
+               Rewrite (N,
+                 New_Occurrence_Of (Standard_False, Loc));
+
+            end if;
+
          --  If a type support function is present (for complex cases), use it
 
          elsif Present (TSS (Root_Type (Typl), TSS_Composite_Equality)) then
@@ -6288,7 +6787,33 @@ package body Exp_Ch4 is
       --  assignment processing.
 
       elsif Is_Record_Type (Target_Type) then
-         Handle_Changed_Representation;
+
+         --  Ada 2005 (AI-216): Program_Error is raised when converting from
+         --  a derived Unchecked_Union type to an unconstrained non-Unchecked_
+         --  Union type if the operand lacks inferable discriminants.
+
+         if Is_Derived_Type (Operand_Type)
+           and then Is_Unchecked_Union (Base_Type (Operand_Type))
+           and then not Is_Constrained (Target_Type)
+           and then not Is_Unchecked_Union (Base_Type (Target_Type))
+           and then not Has_Inferable_Discriminants (Operand)
+         then
+            --  To prevent Gigi from generating illegal code, we make a
+            --  Program_Error node, but we give it the target type of the
+            --  conversion.
+
+            declare
+               PE : constant Node_Id := Make_Raise_Program_Error (Loc,
+                      Reason => PE_Unchecked_Union_Restriction);
+
+            begin
+               Set_Etype (PE, Target_Type);
+               Rewrite (N, PE);
+
+            end;
+         else
+            Handle_Changed_Representation;
+         end if;
 
       --  Case of conversions of enumeration types
 
@@ -6555,31 +7080,6 @@ package body Exp_Ch4 is
    --  Start of processing for Expand_Record_Equality
 
    begin
-      --  Special processing for the unchecked union case, which will occur
-      --  only in the context of tagged types and dynamic dispatching, since
-      --  other cases are handled statically. We return True, but insert a
-      --  raise Program_Error statement.
-
-      if Is_Unchecked_Union (Typ) then
-
-         --  If this is a component of an enclosing record, return the Raise
-         --  statement directly.
-
-         if No (Parent (Lhs)) then
-            Result :=
-              Make_Raise_Program_Error (Loc,
-                Reason => PE_Unchecked_Union_Restriction);
-            Set_Etype (Result, Standard_Boolean);
-            return Result;
-
-         else
-            Insert_Action (Lhs,
-              Make_Raise_Program_Error (Loc,
-                Reason => PE_Unchecked_Union_Restriction));
-            return New_Occurrence_Of (Standard_True, Loc);
-         end if;
-      end if;
-
       --  Generates the following code: (assuming that Typ has one Discr and
       --  component C2 is also a record)
 
@@ -6712,6 +7212,90 @@ package body Exp_Ch4 is
       return Find_Final_List (Owner);
    end Get_Allocator_Final_List;
 
+   ---------------------------------
+   -- Has_Inferable_Discriminants --
+   ---------------------------------
+
+   function Has_Inferable_Discriminants (N : Node_Id) return Boolean is
+
+      function Prefix_Is_Formal_Parameter (N : Node_Id) return Boolean;
+      --  Determines whether the left-most prefix of a selected component is a
+      --  formal parameter in a subprogram. Assumes N is a selected component.
+
+      --------------------------------
+      -- Prefix_Is_Formal_Parameter --
+      --------------------------------
+
+      function Prefix_Is_Formal_Parameter (N : Node_Id) return Boolean is
+         Sel_Comp : Node_Id := N;
+
+      begin
+         --  Move to the left-most prefix by climbing up the tree
+
+         while Present (Parent (Sel_Comp))
+           and then Nkind (Parent (Sel_Comp)) = N_Selected_Component
+         loop
+            Sel_Comp := Parent (Sel_Comp);
+         end loop;
+
+         return Ekind (Entity (Prefix (Sel_Comp))) in Formal_Kind;
+      end Prefix_Is_Formal_Parameter;
+
+   --  Start of processing for Has_Inferable_Discriminants
+
+   begin
+      --  For identifiers and indexed components, it is sufficent to have a
+      --  constrained Unchecked_Union nominal subtype.
+
+      if Nkind (N) = N_Identifier
+           or else
+         Nkind (N) = N_Indexed_Component
+      then
+         return Is_Unchecked_Union (Base_Type (Etype (N)))
+                  and then
+                Is_Constrained (Etype (N));
+
+      --  For selected components, the subtype of the selector must be a
+      --  constrained Unchecked_Union. If the component is subject to a
+      --  per-object constraint, then the enclosing object must have inferable
+      --  discriminants.
+
+      elsif Nkind (N) = N_Selected_Component then
+         if Has_Per_Object_Constraint (Entity (Selector_Name (N))) then
+
+            --  A small hack. If we have a per-object constrained selected
+            --  component of a formal parameter, return True since we do not
+            --  know the actual parameter association yet.
+
+            if Prefix_Is_Formal_Parameter (N) then
+               return True;
+            end if;
+
+            --  Otherwise, check the enclosing object and the selector
+
+            return Has_Inferable_Discriminants (Prefix (N))
+                     and then
+                   Has_Inferable_Discriminants (Selector_Name (N));
+         end if;
+
+         --  The call to Has_Inferable_Discriminants will determine whether
+         --  the selector has a constrained Unchecked_Union nominal type.
+
+         return Has_Inferable_Discriminants (Selector_Name (N));
+
+      --  A qualified expression has inferable discriminants if its subtype
+      --  mark is a constrained Unchecked_Union subtype.
+
+      elsif Nkind (N) = N_Qualified_Expression then
+         return Is_Unchecked_Union (Subtype_Mark (N))
+                  and then
+                Is_Constrained (Subtype_Mark (N));
+
+      end if;
+
+      return False;
+   end Has_Inferable_Discriminants;
+
    -------------------------------
    -- Insert_Dereference_Action --
    -------------------------------