+2009-07-23 Robert Dewar <dewar@adacore.com>
+
+ * 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 <dewar@adacore.com>
* get_scos.adb (Skip_EOL): Fix error of mishandling end of line after
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;
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
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
-- 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
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;
Typ := Non_Limited_View (Typ);
end if;
+ -- Comment needed ???
+
if Generate_SCIL then
Insert_Action (Call_Node,
New_Scil_Node
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;
New_Reference_To
(RTE (RE_No_Dispatch_Table_Wrapper), Loc)));
+ -- Comment needed ???
+
if Generate_SCIL then
Insert_Before (Last (Result),
New_Scil_Node
Constraint => Make_Index_Or_Discriminant_Constraint (Loc,
Constraints => DT_Constr_List))));
+ -- Comment needed ???
+
if Generate_SCIL then
Insert_Before (Last (Result),
New_Scil_Node
(RTE_Record_Component (RE_Prims_Ptr), Loc)),
Attribute_Name => Name_Address))));
+ -- Comment needed ???
+
if Generate_SCIL then
Insert_Before (Last (Result),
New_Scil_Node
Expression => Make_Aggregate (Loc,
Expressions => DT_Aggr_List)));
+ -- Comment needed ???
+
if Generate_SCIL then
Insert_Before (Last (Result),
New_Scil_Node
Expression => Make_Aggregate (Loc,
Expressions => DT_Aggr_List)));
+ -- Comment needed ???
+
if Generate_SCIL then
Insert_Before (Last (Result),
New_Scil_Node
(RTE_Record_Component (RE_Prims_Ptr), Loc)),
Attribute_Name => Name_Address))));
+ -- Comment needed ???
+
if Generate_SCIL then
Insert_Before (Last (Result),
New_Scil_Node
(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
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;
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;
-- 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,
-- 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 --
----------------
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
git://gcc.gnu.org / gcc.git / commitdiff