From c0f136cd17132ceeb25dadb4c97f474d37924cbd Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 22 Oct 2010 12:02:10 +0200 Subject: [PATCH] [multiple changes] 2010-10-22 Arnaud Charlet * a-locale.adb: Minor code clean up. 2010-10-22 Thomas Quinot * exp_ch4.adb: Minor code reorganization and factoring. From-SVN: r165813 --- gcc/ada/ChangeLog | 8 +++ gcc/ada/a-locale.adb | 4 +- gcc/ada/exp_ch4.adb | 140 ++++++++++++++++++++++--------------------- 3 files changed, 81 insertions(+), 71 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7b62fc22d1c..5e656f9f3f0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2010-10-22 Arnaud Charlet + + * a-locale.adb: Minor code clean up. + +2010-10-22 Thomas Quinot + + * exp_ch4.adb: Minor code reorganization and factoring. + 2010-10-22 Thomas Quinot * exp_ch5.adb, sem_ch5.adb, sinfo.ads, snames.ads-tmpl, par-ch5.adb: diff --git a/gcc/ada/a-locale.adb b/gcc/ada/a-locale.adb index 64c51256ad1..d56970c86e9 100644 --- a/gcc/ada/a-locale.adb +++ b/gcc/ada/a-locale.adb @@ -45,7 +45,7 @@ package body Ada.Locales is pragma Import (C, C_Get_Language_Code); F : Lower_4; begin - C_Get_Language_Code (F (1)'Address); + C_Get_Language_Code (F'Address); return Language_Code (F (1 .. 3)); end Language; @@ -58,7 +58,7 @@ package body Ada.Locales is pragma Import (C, C_Get_Country_Code); F : Upper_4; begin - C_Get_Country_Code (F (1)'Address); + C_Get_Country_Code (F'Address); return Country_Code (F (1 .. 2)); end Country; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 31a43db6ba1..4450a1efc05 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -4398,17 +4398,23 @@ package body Exp_Ch4 is procedure Substitute_Valid_Check is begin - Rewrite (N, - Make_Attribute_Reference (Loc, - Prefix => Relocate_Node (Lop), - Attribute_Name => Name_Valid)); + -- Don't do this for type with predicates, since we don't care in + -- this case if it gets optimized away, the critical test is the + -- call to the predicate function - Analyze_And_Resolve (N, Restyp); + if not Has_Predicates (Ltyp) then + Rewrite (N, + Make_Attribute_Reference (Loc, + Prefix => Relocate_Node (Lop), + Attribute_Name => Name_Valid)); - Error_Msg_N ("?explicit membership test may be optimized away", N); - Error_Msg_N -- CODEFIX - ("\?use ''Valid attribute instead", N); - return; + Analyze_And_Resolve (N, Restyp); + + Error_Msg_N ("?explicit membership test may be optimized away", N); + Error_Msg_N -- CODEFIX + ("\?use ''Valid attribute instead", N); + return; + end if; end Substitute_Valid_Check; -- Start of processing for Expand_N_In @@ -4682,7 +4688,10 @@ package body Exp_Ch4 is -- type if they come from the original type definition. Also this -- way we get all the processing above for an explicit range. - elsif Is_Scalar_Type (Typ) then + -- Don't do this for a type with predicates, since we would lose + -- the predicate from this rewriting (test goes to base type). + + elsif Is_Scalar_Type (Typ) and then not Has_Predicates (Typ) then Rewrite (Rop, Make_Range (Loc, Low_Bound => @@ -7426,79 +7435,72 @@ package body Exp_Ch4 is -- Expand_N_Quantified_Expression -- ------------------------------------ - procedure Expand_N_Quantified_Expression (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - Cond : constant Node_Id := Condition (N); + -- We expand: - Actions : List_Id; - Decl : Node_Id; - I_Scheme : Node_Id; - Test : Node_Id; - Tnn : Entity_Id; + -- for all X in range => Cond - -- We expand: + -- into: - -- for all X in range => Cond + -- T := True; + -- for X in range loop + -- if not Cond then + -- T := False; + -- exit; + -- end if; + -- end loop; - -- into: + -- Conversely, an existentially quantified expression: - -- R := True; - -- for all X in range loop - -- if not Cond then - -- R := False; - -- exit; - -- end if; - -- end loop; + -- for some X in range => Cond - -- Conversely, an existentially quantified expression becomes: + -- becomes: - -- R := False; - -- for all X in range loop - -- if Cond then - -- R := True; - -- exit; - -- end if; - -- end loop; + -- T := False; + -- for X in range loop + -- if Cond then + -- T := True; + -- exit; + -- end if; + -- end loop; - -- In both cases, the iteration may be over a container, in which - -- case it is given by an iterator specification, not a loop. + -- In both cases, the iteration may be over a container in which case it is + -- given by an iterator specification, not a loop parameter specification. + + procedure Expand_N_Quantified_Expression (N : Node_Id) is + Loc : constant Source_Ptr := Sloc (N); + Is_Universal : constant Boolean := All_Present (N); + Actions : constant List_Id := New_List; + Tnn : constant Entity_Id := Make_Temporary (Loc, 'T', N); + Cond : Node_Id; + Decl : Node_Id; + I_Scheme : Node_Id; + Test : Node_Id; begin - Actions := New_List; - Tnn := Make_Temporary (Loc, 'T'); Decl := Make_Object_Declaration (Loc, Defining_Identifier => Tnn, - Object_Definition => New_Occurrence_Of (Standard_Boolean, Loc)); - + Object_Definition => New_Occurrence_Of (Standard_Boolean, Loc), + Expression => + New_Occurrence_Of (Boolean_Literals (Is_Universal), Loc)); Append_To (Actions, Decl); - if All_Present (N) then - Set_Expression (Decl, New_Occurrence_Of (Standard_True, Loc)); + Cond := Relocate_Node (Condition (N)); - Test := - Make_If_Statement (Loc, - Condition => - Make_Op_Not (Loc, Relocate_Node (Cond)), - Then_Statements => New_List ( - Make_Assignment_Statement (Loc, - Name => New_Occurrence_Of (Tnn, Loc), - Expression => New_Occurrence_Of (Standard_False, Loc)), - Make_Exit_Statement (Loc))); - - else - Set_Expression (Decl, New_Occurrence_Of (Standard_False, Loc)); - - Test := - Make_If_Statement (Loc, - Condition => Relocate_Node (Cond), - Then_Statements => New_List ( - Make_Assignment_Statement (Loc, - Name => New_Occurrence_Of (Tnn, Loc), - Expression => New_Occurrence_Of (Standard_True, Loc)), - Make_Exit_Statement (Loc))); + if Is_Universal then + Cond := Make_Op_Not (Loc, Cond); end if; + Test := + Make_Implicit_If_Statement (N, + Condition => Cond, + Then_Statements => New_List ( + Make_Assignment_Statement (Loc, + Name => New_Occurrence_Of (Tnn, Loc), + Expression => + New_Occurrence_Of (Boolean_Literals (not Is_Universal), Loc)), + Make_Exit_Statement (Loc))); + if Present (Loop_Parameter_Specification (N)) then I_Scheme := Make_Iteration_Scheme (Loc, @@ -7513,11 +7515,11 @@ package body Exp_Ch4 is Append_To (Actions, Make_Loop_Statement (Loc, Iteration_Scheme => I_Scheme, - Statements => New_List (Test), - End_Label => Empty)); + Statements => New_List (Test), + End_Label => Empty)); - -- The components of the scheme have already been analyzed, and the - -- loop index declaration has been processed. + -- The components of the scheme have already been analyzed, and the loop + -- parameter declaration has been processed. Set_Analyzed (Iteration_Scheme (Last (Actions))); -- 2.30.2