From: Arnaud Charlet Date: Fri, 14 Oct 2011 14:56:46 +0000 (+0200) Subject: [multiple changes] X-Git-Tag: releases/gcc-4.7.0~3109 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=f2d10a021be8e8f57bcf3708bec8db12eb2b8e4d;p=thirdparty%2Fgcc.git [multiple changes] 2011-10-14 Ed Schonberg * sem_util.adb: Return objects are aliased if their type is immutably limited as per AI05-0053. 2011-10-14 Gary Dismukes * exp_ch4.adb (Expand_N_Op_And): Remove Short_Circuit_And_Or expansion code (moved to sem_res) (Expand_N_Op_Or): Remove Short_Circuit_And_Or expansion code (moved to sem_res). * sem_res.adb (Resolve_Logical_Op): Add code to rewrite Boolean "and" and "or" operators as short-circuit "and then" and "or else", when pragma Short_Circuit_And_Or is active. From-SVN: r179985 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f0a7da89f991..2bba0278f2ab 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2011-10-14 Ed Schonberg + + * sem_util.adb: Return objects are aliased if their type is + immutably limited as per AI05-0053. + +2011-10-14 Gary Dismukes + + * exp_ch4.adb (Expand_N_Op_And): Remove Short_Circuit_And_Or + expansion code (moved to sem_res) (Expand_N_Op_Or): Remove + Short_Circuit_And_Or expansion code (moved to sem_res). + * sem_res.adb (Resolve_Logical_Op): Add code to rewrite Boolean + "and" and "or" operators as short-circuit "and then" and "or + else", when pragma Short_Circuit_And_Or is active. + 2011-10-13 Robert Dewar * sem_ch9.adb, sem_util.adb, sem_util.ads, exp_ch6.adb, sem_ch4.adb, diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index d0536f762a08..87e02d0e1ee9 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -5579,26 +5579,10 @@ package body Exp_Ch4 is Expand_Boolean_Operator (N); elsif Is_Boolean_Type (Etype (N)) then - - -- Replace AND by AND THEN if Short_Circuit_And_Or active and the - -- type is standard Boolean (do not mess with AND that uses a non- - -- standard Boolean type, because something strange is going on). - - if Short_Circuit_And_Or and then Typ = Standard_Boolean then - Rewrite (N, - Make_And_Then (Sloc (N), - Left_Opnd => Relocate_Node (Left_Opnd (N)), - Right_Opnd => Relocate_Node (Right_Opnd (N)))); - Analyze_And_Resolve (N, Typ); - - -- Otherwise, adjust conditions - - else - Adjust_Condition (Left_Opnd (N)); - Adjust_Condition (Right_Opnd (N)); - Set_Etype (N, Standard_Boolean); - Adjust_Result_Type (N, Typ); - end if; + Adjust_Condition (Left_Opnd (N)); + Adjust_Condition (Right_Opnd (N)); + Set_Etype (N, Standard_Boolean); + Adjust_Result_Type (N, Typ); elsif Is_Intrinsic_Subprogram (Entity (N)) then Expand_Intrinsic_Call (N, Entity (N)); @@ -7535,26 +7519,10 @@ package body Exp_Ch4 is Expand_Boolean_Operator (N); elsif Is_Boolean_Type (Etype (N)) then - - -- Replace OR by OR ELSE if Short_Circuit_And_Or active and the type - -- is standard Boolean (do not mess with AND that uses a non-standard - -- Boolean type, because something strange is going on). - - if Short_Circuit_And_Or and then Typ = Standard_Boolean then - Rewrite (N, - Make_Or_Else (Sloc (N), - Left_Opnd => Relocate_Node (Left_Opnd (N)), - Right_Opnd => Relocate_Node (Right_Opnd (N)))); - Analyze_And_Resolve (N, Typ); - - -- Otherwise, adjust conditions - - else - Adjust_Condition (Left_Opnd (N)); - Adjust_Condition (Right_Opnd (N)); - Set_Etype (N, Standard_Boolean); - Adjust_Result_Type (N, Typ); - end if; + Adjust_Condition (Left_Opnd (N)); + Adjust_Condition (Right_Opnd (N)); + Set_Etype (N, Standard_Boolean); + Adjust_Result_Type (N, Typ); elsif Is_Intrinsic_Subprogram (Entity (N)) then Expand_Intrinsic_Call (N, Entity (N)); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 7f10c2662251..d71bde63974b 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -7356,6 +7356,48 @@ package body Sem_Res is Check_For_Visible_Operator (N, B_Typ); end if; + -- Replace AND by AND THEN, or OR by OR ELSE, if Short_Circuit_And_Or + -- is active and the result type is standard Boolean (do not mess with + -- ops that return a nonstandard Boolean type, because something strange + -- is going on). + + -- Note: you might expect this replacement to be done during expansion, + -- but that doesn't work, because when the pragma Short_Circuit_And_Or + -- is used, no part of the right operand of an "and" or "or" operator + -- should be executed if the left operand would short-circuit the + -- evaluation of the corresponding "and then" or "or else". If we left + -- the replacement to expansion time, then run-time checks associated + -- with such operands would be evaluated unconditionally, due to being + -- before to the condition prior to the rewriting as short-circuit forms + -- during expansion. + + if Short_Circuit_And_Or + and then B_Typ = Standard_Boolean + and then Nkind_In (N, N_Op_And, N_Op_Or) + then + if Nkind (N) = N_Op_And then + Rewrite (N, + Make_And_Then (Sloc (N), + Left_Opnd => Relocate_Node (Left_Opnd (N)), + Right_Opnd => Relocate_Node (Right_Opnd (N)))); + Analyze_And_Resolve (N, B_Typ); + + -- Case of OR changed to OR ELSE + + else + Rewrite (N, + Make_Or_Else (Sloc (N), + Left_Opnd => Relocate_Node (Left_Opnd (N)), + Right_Opnd => Relocate_Node (Right_Opnd (N)))); + Analyze_And_Resolve (N, B_Typ); + end if; + + -- Return now, since analysis of the rewritten ops will take care of + -- other reference bookkeeping and expression folding. + + return; + end if; + Resolve (Left_Opnd (N), B_Typ); Resolve (Right_Opnd (N), B_Typ); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 366be68519c6..1375225c5126 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -6567,19 +6567,18 @@ package body Sem_Util is (Is_Object (E) and then (Is_Aliased (E) - or else (Present (Renamed_Object (E)) - and then Is_Aliased_View (Renamed_Object (E))))) + or else (Present (Renamed_Object (E)) + and then Is_Aliased_View (Renamed_Object (E))))) or else ((Is_Formal (E) or else Ekind (E) = E_Generic_In_Out_Parameter or else Ekind (E) = E_Generic_In_Parameter) and then Is_Tagged_Type (Etype (E))) - or else (Is_Concurrent_Type (E) - and then In_Open_Scopes (E)) + or else (Is_Concurrent_Type (E) and then In_Open_Scopes (E)) - -- Current instance of type, either directly or as rewritten - -- reference to the current object. + -- Current instance of type, either directly or as rewritten + -- reference to the current object. or else (Is_Entity_Name (Original_Node (Obj)) and then Present (Entity (Original_Node (Obj))) @@ -6588,7 +6587,13 @@ package body Sem_Util is or else (Is_Type (E) and then E = Current_Scope) or else (Is_Incomplete_Or_Private_Type (E) - and then Full_View (E) = Current_Scope); + and then Full_View (E) = Current_Scope) + + -- Ada 2012 AI05-0053: the return object of an extended return + -- statement is aliased if its type is immutably limited. + + or else (Is_Return_Object (E) + and then Is_Immutably_Limited_Type (Etype (E))); elsif Nkind (Obj) = N_Selected_Component then return Is_Aliased (Entity (Selector_Name (Obj)));