diff options
author | Thomas Quinot <quinot@adacore.com> | 2012-06-12 10:07:29 +0000 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2012-06-12 12:07:29 +0200 |
commit | 83bb90af7af5df4179c85586409efe342d655b90 (patch) | |
tree | 11ff71a3be65dc04fda99dc9197d9e47e6db5c94 /gcc/ada | |
parent | 586ecbf363a2a4209c5bacc0d292f3bf08f784e1 (diff) | |
download | gcc-83bb90af7af5df4179c85586409efe342d655b90.zip gcc-83bb90af7af5df4179c85586409efe342d655b90.tar.gz gcc-83bb90af7af5df4179c85586409efe342d655b90.tar.bz2 |
sem_prag.adb (Analyze_Pragma, [...]): Do not crash on illegal unchecked union that is a null record.
2012-06-12 Thomas Quinot <quinot@adacore.com>
* 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 <quinot@adacore.com>
* 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
Diffstat (limited to 'gcc/ada')
-rw-r--r-- | gcc/ada/ChangeLog | 11 | ||||
-rw-r--r-- | gcc/ada/exp_ch4.adb | 35 | ||||
-rw-r--r-- | gcc/ada/sem_prag.adb | 17 |
3 files changed, 39 insertions, 24 deletions
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 <quinot@adacore.com> + + * 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 <quinot@adacore.com> + + * 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 <dewar@adacore.com> * 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); |