The flag Do_Discriminant_Check was set during semantic analysis only when
expansion was also performed. Now set it unconditionally when needed. Also
clarify in the associated documentation that it is set also for Unchecked_Union
but not expanded into an actual check in that case.
Tested on x86_64-pc-linux-gnu, committed on trunk
2013-04-11 Yannick Moy <m...@adacore.com>
* exp_ch4.adb (Expand_N_Selected_Component): Do not expand
discriminant check for Unchecked_Union.
* sem_res.adb (Resolve_Selected_Component): Set flag
Do_Discriminant_Check even when expansion is not performed.
* sinfo.ads (Do_Discriminant_Check): Update documentation for the case
of Unchecked_Union.
Index: sinfo.ads
===================================================================
--- sinfo.ads (revision 197766)
+++ sinfo.ads (working copy)
@@ -807,7 +807,10 @@
-- This flag is set on N_Selected_Component nodes to indicate that a
-- discriminant check is required using the discriminant check routine
-- associated with the selector. The actual check is generated by the
- -- expander when processing selected components.
+ -- expander when processing selected components. In the case of
+ -- Unchecked_Union, the flag is also set, but no discriminant check
+ -- routine is associated with the selector, and the expander does not
+ -- generate a check.
-- Do_Division_Check (Flag13-Sem)
-- This flag is set on a division operator (/ mod rem) to indicate
Index: sem_res.adb
===================================================================
--- sem_res.adb (revision 197777)
+++ sem_res.adb (working copy)
@@ -8798,8 +8798,6 @@
and then Ekind_In (Entity (S), E_Component, E_Discriminant)
and then Present (Original_Record_Component (Entity (S)))
and then Ekind (Original_Record_Component (Entity (S))) = E_Component
- and then Present (Discriminant_Checking_Func
- (Original_Record_Component (Entity (S))))
and then not Discriminant_Checks_Suppressed (T)
and then not Init_Component
then
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb (revision 197777)
+++ exp_ch4.adb (working copy)
@@ -9198,6 +9198,7 @@
Loc : constant Source_Ptr := Sloc (N);
Par : constant Node_Id := Parent (N);
P : constant Node_Id := Prefix (N);
+ S : constant Node_Id := Selector_Name (N);
Ptyp : Entity_Id := Underlying_Type (Etype (P));
Disc : Entity_Id;
New_N : Node_Id;
@@ -9273,18 +9274,27 @@
-- Deal with discriminant check required
if Do_Discriminant_Check (N) then
+ if Present (Discriminant_Checking_Func
+ (Original_Record_Component (Entity (S))))
+ then
+ -- Present the discriminant checking function to the backend, so
+ -- that it can inline the call to the function.
- -- Present the discriminant checking function to the backend, so that
- -- it can inline the call to the function.
+ Add_Inlined_Body
+ (Discriminant_Checking_Func
+ (Original_Record_Component (Entity (S))));
- Add_Inlined_Body
- (Discriminant_Checking_Func
- (Original_Record_Component (Entity (Selector_Name (N)))));
+ -- Now reset the flag and generate the call
- -- Now reset the flag and generate the call
+ Set_Do_Discriminant_Check (N, False);
+ Generate_Discriminant_Check (N);
- Set_Do_Discriminant_Check (N, False);
- Generate_Discriminant_Check (N);
+ -- In the case of Unchecked_Union, no discriminant checking is
+ -- actually performed.
+
+ else
+ Set_Do_Discriminant_Check (N, False);
+ end if;
end if;
-- Ada 2005 (AI-318-02): If the prefix is a call to a build-in-place
