From 97cb64f052a76046aaf4d3290ef5ceb744f3e779 Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Thu, 23 Jul 2009 09:10:58 +0000 Subject: [PATCH] exp_ch5.adb (Expand_N_Assignment_Statement): Do left-side validity check right away so it does not get skipped for early... 2009-07-23 Robert Dewar * exp_ch5.adb (Expand_N_Assignment_Statement): Do left-side validity check right away so it does not get skipped for early returns, e.g. array assignments. (Expand_N_Assignment_Statement): Don't propagate Is_Known_Valid to left-side unless we really know the value is valid. * errout.adb, exp_ch3.adb, exp_disp.ads, sinfo.ads, exp_disp.adb: Minor reformatting. Minor code reorganization. Add comments. From-SVN: r149978 --- gcc/ada/ChangeLog | 11 +++++++++++ gcc/ada/errout.adb | 2 +- gcc/ada/exp_ch3.adb | 2 ++ gcc/ada/exp_ch5.adb | 48 ++++++++++++++++++++++++++++++++++-------------- gcc/ada/exp_disp.adb | 32 +++++++++++++++++++++++--------- gcc/ada/exp_disp.ads | 6 ++++-- gcc/ada/sinfo.ads | 8 ++++++++ 7 files changed, 83 insertions(+), 26 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index bbd2fa4..b9d9baf 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,16 @@ 2009-07-23 Robert Dewar + * exp_ch5.adb (Expand_N_Assignment_Statement): Do left-side validity + check right away so it does not get skipped for early returns, e.g. + array assignments. + (Expand_N_Assignment_Statement): Don't propagate Is_Known_Valid to + left-side unless we really know the value is valid. + + * errout.adb, exp_ch3.adb, exp_disp.ads, sinfo.ads, exp_disp.adb: Minor + reformatting. Minor code reorganization. Add comments. + +2009-07-23 Robert Dewar + * get_scos.adb (Skip_EOL): Fix error of mishandling end of line after complex condition. diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 377c3f4..f05a4dd 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -1101,7 +1101,7 @@ package body Errout is if No_Warnings (N) or else No_Warnings (E) then - -- Disable as well continuation messages, if any. + -- Disable any continuation messages as well Last_Killed := True; return; diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 2b2b702..c2b5595 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -2322,6 +2322,8 @@ package body Exp_Ch3 is New_Reference_To (Node (First_Elmt (Access_Disp_Table (Rec_Type))), Loc))); + -- Following code needs a comment ??? + if Generate_SCIL then Prepend_To (Init_Tags_List, New_Scil_Node diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 94a038e..7886266 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -1483,6 +1483,20 @@ package body Exp_Ch5 is return; end if; + -- Defend against invalid subscripts on left side if we are in standard + -- validity checking mode. No need to do this if we are checking all + -- subscripts. + + -- Note that we do this right away, because there are some early return + -- paths in this procedure, and this is required on all paths. + + if Validity_Checks_On + and then Validity_Check_Default + and then not Validity_Check_Subscripts + then + Check_Valid_Lvalue_Subscripts (Lhs); + end if; + -- Ada 2005 (AI-327): Handle assignment to priority of protected object -- Rewrite an assignment to X'Priority into a run-time call @@ -2065,14 +2079,31 @@ package body Exp_Ch5 is -- Here the right side is valid, so it is fine. The case to deal -- with is when the left side is a local variable reference whose -- value is not currently known to be valid. If this is the case, - -- and the assignment appears in an unconditional context, then we - -- can mark the left side as now being valid. + -- and the assignment appears in an unconditional context, then + -- we can mark the left side as now being valid if one of these + -- conditions holds: + + -- The expression of the right side has Do_Range_Check set so + -- that we know a range check will be performed. Note that it + -- can be the case that a range check is omitted because we + -- make the assumption that we can assume validity for operands + -- appearing in the right side in determining whether a range + -- check is required + + -- The subtype of the right side matches the subtype of the + -- left side. In this case, even though we have not checked + -- the range of the right side, we know it is in range of its + -- subtype if the expression is valid. if Is_Local_Variable_Reference (Lhs) and then not Is_Known_Valid (Entity (Lhs)) and then In_Unconditional_Context (N) then - Set_Is_Known_Valid (Entity (Lhs), True); + if Do_Range_Check (Rhs) + or else Etype (Lhs) = Etype (Rhs) + then + Set_Is_Known_Valid (Entity (Lhs), True); + end if; end if; -- Case where right side may be invalid in the sense of the RM @@ -2145,17 +2176,6 @@ package body Exp_Ch5 is end if; end if; - -- Defend against invalid subscripts on left side if we are in standard - -- validity checking mode. No need to do this if we are checking all - -- subscripts. - - if Validity_Checks_On - and then Validity_Check_Default - and then not Validity_Check_Subscripts - then - Check_Valid_Lvalue_Subscripts (Lhs); - end if; - exception when RE_Not_Available => return; diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 7e312da..5e70038 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -643,6 +643,8 @@ package body Exp_Disp is Typ := Non_Limited_View (Typ); end if; + -- Comment needed ??? + if Generate_SCIL then Insert_Action (Call_Node, New_Scil_Node @@ -1611,9 +1613,8 @@ package body Exp_Disp is function Get_Scil_Node_Kind (Node : Node_Id) return Scil_Node_Kind is begin - pragma Assert (Nkind (Node) = N_Null_Statement - and then Is_Scil_Node (Node)); - + pragma Assert + (Nkind (Node) = N_Null_Statement and then Is_Scil_Node (Node)); return Scil_Node_Kind'Val (UI_To_Int (Scil_Nkind (Node))); end Get_Scil_Node_Kind; @@ -4242,6 +4243,8 @@ package body Exp_Disp is New_Reference_To (RTE (RE_No_Dispatch_Table_Wrapper), Loc))); + -- Comment needed ??? + if Generate_SCIL then Insert_Before (Last (Result), New_Scil_Node @@ -4313,6 +4316,8 @@ package body Exp_Disp is Constraint => Make_Index_Or_Discriminant_Constraint (Loc, Constraints => DT_Constr_List)))); + -- Comment needed ??? + if Generate_SCIL then Insert_Before (Last (Result), New_Scil_Node @@ -4347,6 +4352,8 @@ package body Exp_Disp is (RTE_Record_Component (RE_Prims_Ptr), Loc)), Attribute_Name => Name_Address)))); + -- Comment needed ??? + if Generate_SCIL then Insert_Before (Last (Result), New_Scil_Node @@ -5123,6 +5130,8 @@ package body Exp_Disp is Expression => Make_Aggregate (Loc, Expressions => DT_Aggr_List))); + -- Comment needed ??? + if Generate_SCIL then Insert_Before (Last (Result), New_Scil_Node @@ -5437,6 +5446,8 @@ package body Exp_Disp is Expression => Make_Aggregate (Loc, Expressions => DT_Aggr_List))); + -- Comment needed ??? + if Generate_SCIL then Insert_Before (Last (Result), New_Scil_Node @@ -6135,6 +6146,8 @@ package body Exp_Disp is (RTE_Record_Component (RE_Prims_Ptr), Loc)), Attribute_Name => Name_Address)))); + -- Comment needed ??? + if Generate_SCIL then Insert_Before (Last (Result), New_Scil_Node @@ -6178,6 +6191,8 @@ package body Exp_Disp is (RTE_Record_Component (RE_NDT_Prims_Ptr), Loc)), Attribute_Name => Name_Address)))); + -- Comment needed ??? + if Generate_SCIL then Insert_Before (Last (Result), New_Scil_Node @@ -6400,8 +6415,9 @@ package body Exp_Disp is Res : constant Node_Id := Duplicate_Subexpr (From); begin if Is_Access_Type (Etype (From)) then - return Make_Explicit_Dereference (Sloc (From), - Prefix => Res); + return + Make_Explicit_Dereference (Sloc (From), + Prefix => Res); else return Res; end if; @@ -6417,16 +6433,14 @@ package body Exp_Disp is Entity : Entity_Id := Empty; Target_Prim : Entity_Id := Empty) return Node_Id is - New_N : Node_Id; - + New_N : constant Node_Id := + New_Node (N_Null_Statement, Sloc (Related_Node)); begin - New_N := New_Node (N_Null_Statement, Sloc (Related_Node)); Set_Is_Scil_Node (New_N); Set_Scil_Nkind (New_N, UI_From_Int (Scil_Node_Kind'Pos (Nkind))); Set_Scil_Related_Node (New_N, Related_Node); Set_Entity (New_N, Entity); Set_Scil_Target_Prim (New_N, Target_Prim); - return New_N; end New_Scil_Node; diff --git a/gcc/ada/exp_disp.ads b/gcc/ada/exp_disp.ads index fab99c2..05609c3 100644 --- a/gcc/ada/exp_disp.ads +++ b/gcc/ada/exp_disp.ads @@ -34,8 +34,10 @@ package Exp_Disp is -- SCIL Node Type Definition -- ------------------------------- - type Scil_Node_Kind is ( - Unused, + -- Comment required! ??? What is this type??? + + type Scil_Node_Kind is + (Unused, IP_Tag_Init, Dispatching_Call, Dispatch_Table_Object_Init, diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 4966bb7..213812d 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -3842,6 +3842,12 @@ package Sinfo is -- Entity (Node4-Sem) -- Scil_Target_Prim (Node2-Sem) + -- What are the above Scil fields for, and what has this got to do with + -- null statements. MAJOR MISSING DOC HERE ??? All -Sem fields must be + -- individually documented in the list of -Sem fields at the start of + -- Sinfo, and we sure need significant documentation here explaining + -- what on earth is going on with null statements! + ---------------- -- 5.1 Label -- ---------------- @@ -7234,6 +7240,8 @@ package Sinfo is N_Goto_Statement, N_Loop_Statement, N_Null_Statement, + -- N_Null_Statement now has an Entity field, but is not in N_Has_Entity. + -- Either fix this, or document this peculiar irregularity ??? N_Raise_Statement, N_Requeue_Statement, N_Return_Statement, -- renamed as N_Simple_Return_Statement below -- 2.7.4