From 83bb90af7af5df4179c85586409efe342d655b90 Mon Sep 17 00:00:00 2001 From: Thomas Quinot Date: Tue, 12 Jun 2012 10:07:29 +0000 Subject: sem_prag.adb (Analyze_Pragma, [...]): Do not crash on illegal unchecked union that is a null record. 2012-06-12 Thomas Quinot * sem_prag.adb (Analyze_Pragma, case Unchecked_Union): Do not crash on illegal unchecked union that is a null record. 2012-06-12 Thomas Quinot * exp_ch4.adb (Has_Inferable_Discriminants): Reorganize code to treat implicit dereferences with a constrained unchecked union nominal subtype as having inferable discriminants. From-SVN: r188437 --- gcc/ada/ChangeLog | 11 +++++++++++ gcc/ada/exp_ch4.adb | 35 +++++++++++++++++------------------ gcc/ada/sem_prag.adb | 17 +++++++++++------ 3 files changed, 39 insertions(+), 24 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c10eef0..7eab91e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2012-06-12 Thomas Quinot + + * sem_prag.adb (Analyze_Pragma, case Unchecked_Union): Do + not crash on illegal unchecked union that is a null record. + +2012-06-12 Thomas Quinot + + * exp_ch4.adb (Has_Inferable_Discriminants): Reorganize code to + treat implicit dereferences with a constrained unchecked union + nominal subtype as having inferable discriminants. + 2012-06-12 Robert Dewar * sem_ch6.adb: Minor reformatting. diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 28d89e3..e115eda 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -10048,11 +10048,12 @@ package body Exp_Ch4 is -------------------------------- function Prefix_Is_Formal_Parameter (N : Node_Id) return Boolean is - Sel_Comp : Node_Id := N; + Sel_Comp : Node_Id; begin -- Move to the left-most prefix by climbing up the tree + Sel_Comp := N; while Present (Parent (Sel_Comp)) and then Nkind (Parent (Sel_Comp)) = N_Selected_Component loop @@ -10065,20 +10066,12 @@ package body Exp_Ch4 is -- Start of processing for Has_Inferable_Discriminants begin - -- For identifiers and indexed components, it is sufficient to have a - -- constrained Unchecked_Union nominal subtype. - - if Nkind_In (N, N_Identifier, 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 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 @@ -10087,19 +10080,20 @@ package body Exp_Ch4 is 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; + else + 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)); + else + return Has_Inferable_Discriminants (Selector_Name (N)); + end if; -- A qualified expression has inferable discriminants if its subtype -- mark is a constrained Unchecked_Union subtype. @@ -10107,9 +10101,14 @@ package body Exp_Ch4 is elsif Nkind (N) = N_Qualified_Expression then return Is_Unchecked_Union (Etype (Subtype_Mark (N))) and then Is_Constrained (Etype (Subtype_Mark (N))); - end if; - return False; + -- For all other names, it is sufficient to have a constrained + -- Unchecked_Union nominal subtype. + + else + return Is_Unchecked_Union (Base_Type (Etype (N))) + and then Is_Constrained (Etype (N)); + end if; end Has_Inferable_Discriminants; ------------------------------- diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index cbcc0be..757ea70 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -14186,18 +14186,23 @@ package body Sem_Prag is Tdef := Type_Definition (Declaration_Node (Typ)); Clist := Component_List (Tdef); + -- Check presence of component list and variant part + + if No (Clist) or else No (Variant_Part (Clist)) then + Error_Msg_N + ("Unchecked_Union must have variant part", Tdef); + return; + end if; + + -- Check components + Comp := First (Component_Items (Clist)); while Present (Comp) loop Check_Component (Comp, Typ); Next (Comp); end loop; - if No (Clist) or else No (Variant_Part (Clist)) then - Error_Msg_N - ("Unchecked_Union must have variant part", - Tdef); - return; - end if; + -- Check variant part Vpart := Variant_Part (Clist); -- cgit v1.1