From 32beb1f3cf05eb53c24bf31faf83ca3f19625149 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 17 Apr 2009 14:01:56 +0200 Subject: [PATCH] [multiple changes] 2009-04-17 Thomas Quinot * exp_aggr.adb: Minor code reorganization, no behaviour change. 2009-04-17 Ed Schonberg * sem_ch8.adb (Use_One_Type): Handle properly a redundant use type clause in a unit that is a package body or a subunit, when the previous clause appears in a spec or a parent. From-SVN: r146250 --- gcc/ada/ChangeLog | 10 ++++++++++ gcc/ada/exp_aggr.adb | 8 ++++---- gcc/ada/sem_ch8.adb | 21 ++++++++++++++++++++- 3 files changed, 34 insertions(+), 5 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6d0d2a6ba73..67f4c53fb42 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2009-04-17 Thomas Quinot + + * exp_aggr.adb: Minor code reorganization, no behaviour change. + +2009-04-17 Ed Schonberg + + * sem_ch8.adb (Use_One_Type): Handle properly a redundant use type + clause in a unit that is a package body or a subunit, when the previous + clause appears in a spec or a parent. + 2009-04-17 Thomas Quinot * sinfo.ads, exp_aggr.adb, exp_aggr.ads: Minor reformatting diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 22e44f4b74e..61fa79021ca 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -1226,10 +1226,10 @@ package body Exp_Aggr is if Present (Comp_Type) and then Needs_Finalization (Comp_Type) and then not Is_Limited_Type (Comp_Type) - and then - (not Is_Array_Type (Comp_Type) - or else not Is_Controlled (Component_Type (Comp_Type)) - or else Nkind (Expr) /= N_Aggregate) + and then not + (Is_Array_Type (Comp_Type) + and then Is_Controlled (Component_Type (Comp_Type)) + and then Nkind (Expr) = N_Aggregate) then Append_List_To (L, Make_Adjust_Call ( diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 4c97e09ee4a..58d9ff68a46 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -7249,7 +7249,9 @@ package body Sem_Ch8 is Unit1 := Unit (Parent (Clause1)); Unit2 := Unit (Parent (Clause2)); - -- If both clauses are on same unit, report redundancy + -- If both clauses are on same unit, or one is the body + -- of the other, or one of them is in a subunit, report + -- redundancy on the later one. if Unit1 = Unit2 then Error_Msg_Sloc := Sloc (Current_Use_Clause (T)); @@ -7257,6 +7259,23 @@ package body Sem_Ch8 is ("& is already use-visible through previous " & "use_type_clause #?", Clause1, T); return; + + elsif Nkind (Unit1) = N_Subunit then + Error_Msg_Sloc := Sloc (Current_Use_Clause (T)); + Error_Msg_NE + ("& is already use-visible through previous " + & "use_type_clause #?", Clause1, T); + return; + + elsif Nkind_In (Unit2, N_Package_Body, N_Subprogram_Body) + and then Nkind (Unit1) /= Nkind (Unit2) + and then Nkind (Unit1) /= N_Subunit + then + Error_Msg_Sloc := Sloc (Clause1); + Error_Msg_NE + ("& is already use-visible through previous " + & "use_type_clause #?", Current_Use_Clause (T), T); + return; end if; -- There is a redundant use type clause in a child unit.