Skip to content

R
riscv-gcc-1
Commit bdc193ba by Arnaud Charlet
Options

[multiple changes] 

2014-08-01  Bob Duff  <duff@adacore.com>

	* gnat_ugn.texi: Minor updates.

2014-08-01  Robert Dewar  <dewar@adacore.com>

	* atree.adb: Minor reformatting.

2014-08-01  Ed Schonberg  <schonberg@adacore.com>

	* exp_aggr.adb (Init_Hidden_Discriminants): If some ancestor is a
	private extension, get stored constraint, if any, from full view.

From-SVN: r213479
parent 8bef7ba9
Showing with 121 additions and 107 deletions
gcc/ada/ChangeLog
2014-08-01 Bob Duff <duff@adacore.com>
* gnat_ugn.texi: Minor updates.
2014-08-01 Robert Dewar <dewar@adacore.com>
* atree.adb: Minor reformatting.
2014-08-01 Ed Schonberg <schonberg@adacore.com>
* exp_aggr.adb (Init_Hidden_Discriminants): If some ancestor is a
private extension, get stored constraint, if any, from full view.
2014-08-01 Robert Dewar <dewar@adacore.com> 2014-08-01 Robert Dewar <dewar@adacore.com>
* opt.ads (No_Elab_Code_All_Pragma): New global variable. * opt.ads (No_Elab_Code_All_Pragma): New global variable.
......
gcc/ada/atree.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -1800,18 +1800,17 @@ package body Atree is ...@@ -1800,18 +1800,17 @@ package body Atree is
New_Node := New_Copy (Source); New_Node := New_Copy (Source);
Fix_Parents (Ref_Node => Source, Fix_Node => New_Node); Fix_Parents (Ref_Node => Source, Fix_Node => New_Node);
-- We now set the parent of the new node to be the same as the -- We now set the parent of the new node to be the same as the parent of
-- parent of the source. Almost always this parent will be -- the source. Almost always this parent will be replaced by a new value
-- replaced by a new value when the relocated node is reattached -- when the relocated node is reattached to the tree, but by doing it
-- to the tree, but by doing it now, we ensure that this node is -- now, we ensure that this node is not even temporarily disconnected
-- not even temporarily disconnected from the tree. Note that this -- from the tree. Note that this does not happen free, because in the
-- does not happen free, because in the list case, the parent does -- list case, the parent does not get set.
-- not get set.
Set_Parent (New_Node, Parent (Source)); Set_Parent (New_Node, Parent (Source));
-- If the node being relocated was a rewriting of some original -- If the node being relocated was a rewriting of some original node,
-- node, then the relocated node has the same original node. -- then the relocated node has the same original node.
if Orig_Nodes.Table (Source) /= Source then if Orig_Nodes.Table (Source) /= Source then
Orig_Nodes.Table (New_Node) := Orig_Nodes.Table (Source); Orig_Nodes.Table (New_Node) := Orig_Nodes.Table (Source);
......
gcc/ada/exp_aggr.adb
...@@ -2132,10 +2132,19 @@ package body Exp_Aggr is ...@@ -2132,10 +2132,19 @@ package body Exp_Aggr is
Disc := First_Discriminant (Parent_Type); Disc := First_Discriminant (Parent_Type);
-- We know that one of the stored-constraint lists is present. -- We know that one of the stored-constraint lists is present
if Present (Stored_Constraint (Btype)) then if Present (Stored_Constraint (Btype)) then
Discr_Val := First_Elmt (Stored_Constraint (Btype)); Discr_Val := First_Elmt (Stored_Constraint (Btype));
-- For private extension, stored constraint may be on full view
elsif Is_Private_Type (Btype)
and then Present (Full_View (Btype))
and then Present (Stored_Constraint (Full_View (Btype)))
then
Discr_Val := First_Elmt (Stored_Constraint (Full_View (Btype)));
else else
Discr_Val := First_Elmt (Stored_Constraint (Typ)); Discr_Val := First_Elmt (Stored_Constraint (Typ));
end if; end if;
...@@ -2197,10 +2206,10 @@ package body Exp_Aggr is ...@@ -2197,10 +2206,10 @@ package body Exp_Aggr is
Finalization_Done := True; Finalization_Done := True;
-- Determine the external finalization list. It is either the -- Determine the external finalization list. It is either the
-- finalization list of the outer-scope or the one coming from -- finalization list of the outer-scope or the one coming from an
-- an outer aggregate. When the target is not a temporary, the -- outer aggregate. When the target is not a temporary, the proper
-- proper scope is the scope of the target rather than the -- scope is the scope of the target rather than the potentially
-- potentially transient current scope. -- transient current scope.
if Is_Controlled (Typ) and then Ancestor_Is_Subtype_Mark then if Is_Controlled (Typ) and then Ancestor_Is_Subtype_Mark then
Ref := Convert_To (Init_Typ, New_Copy_Tree (Target)); Ref := Convert_To (Init_Typ, New_Copy_Tree (Target));
...@@ -2433,6 +2442,7 @@ package body Exp_Aggr is ...@@ -2433,6 +2442,7 @@ package body Exp_Aggr is
-- in the limited case, the ancestor part must be either a -- in the limited case, the ancestor part must be either a
-- function call (possibly qualified, or wrapped in an unchecked -- function call (possibly qualified, or wrapped in an unchecked
-- conversion) or aggregate (definitely qualified). -- conversion) or aggregate (definitely qualified).
-- The ancestor part can also be a function call (that may be -- The ancestor part can also be a function call (that may be
-- transformed into an explicit dereference) or a qualification -- transformed into an explicit dereference) or a qualification
-- of one such. -- of one such.
...@@ -3009,10 +3019,10 @@ package body Exp_Aggr is ...@@ -3009,10 +3019,10 @@ package body Exp_Aggr is
Next (Comp); Next (Comp);
end loop; end loop;
-- If the type is tagged, the tag needs to be initialized (unless -- If the type is tagged, the tag needs to be initialized (unless we
-- compiling for the Java VM where tags are implicit). It is done -- are in VM-mode where tags are implicit). It is done late in the
-- late in the initialization process because in some cases, we call -- initialization process because in some cases, we call the init
-- the init proc of an ancestor which will not leave out the right tag -- proc of an ancestor which will not leave out the right tag.
if Ancestor_Is_Expression then if Ancestor_Is_Expression then
null; null;
...@@ -3042,7 +3052,7 @@ package body Exp_Aggr is ...@@ -3042,7 +3052,7 @@ package body Exp_Aggr is
Append_To (L, Instr); Append_To (L, Instr);
-- Ada 2005 (AI-251): If the tagged type has been derived from -- Ada 2005 (AI-251): If the tagged type has been derived from an
-- abstract interfaces we must also initialize the tags of the -- abstract interfaces we must also initialize the tags of the
-- secondary dispatch tables. -- secondary dispatch tables.
...@@ -3378,16 +3388,16 @@ package body Exp_Aggr is ...@@ -3378,16 +3388,16 @@ package body Exp_Aggr is
or else (Parent_Kind = N_Assignment_Statement or else (Parent_Kind = N_Assignment_Statement
and then Inside_Init_Proc) and then Inside_Init_Proc)
-- (Ada 2005) An inherently limited type in a return statement, -- (Ada 2005) An inherently limited type in a return statement, which
-- which will be handled in a build-in-place fashion, and may be -- will be handled in a build-in-place fashion, and may be rewritten
-- rewritten as an extended return and have its own finalization -- as an extended return and have its own finalization machinery.
-- machinery. In the case of a simple return, the aggregate needs -- In the case of a simple return, the aggregate needs to be delayed
-- to be delayed until the scope for the return statement has been -- until the scope for the return statement has been created, so
-- created, so that any finalization chain will be associated with -- that any finalization chain will be associated with that scope.
-- that scope. For extended returns, we delay expansion to avoid the -- For extended returns, we delay expansion to avoid the creation
-- creation of an unwanted transient scope that could result in -- of an unwanted transient scope that could result in premature
-- premature finalization of the return object (which is built in -- finalization of the return object (which is built in in place
-- in place within the caller's scope). -- within the caller's scope).
or else or else
(Is_Limited_View (Typ) (Is_Limited_View (Typ)
...@@ -3404,9 +3414,9 @@ package body Exp_Aggr is ...@@ -3404,9 +3414,9 @@ package body Exp_Aggr is
end if; end if;
-- If the aggregate is non-limited, create a temporary. If it is limited -- If the aggregate is non-limited, create a temporary. If it is limited
-- and the context is an assignment, this is a subaggregate for an -- and context is an assignment, this is a subaggregate for an enclosing
-- enclosing aggregate being expanded. It must be built in place, so use -- aggregate being expanded. It must be built in place, so use target of
-- the target of the current assignment. -- the current assignment.
if Is_Limited_Type (Typ) if Is_Limited_Type (Typ)
and then Nkind (Parent (N)) = N_Assignment_Statement and then Nkind (Parent (N)) = N_Assignment_Statement
...@@ -3491,6 +3501,8 @@ package body Exp_Aggr is ...@@ -3491,6 +3501,8 @@ package body Exp_Aggr is
-- Check_Static_Components -- -- Check_Static_Components --
----------------------------- -----------------------------
-- Could use some comments in this body ???
procedure Check_Static_Components is procedure Check_Static_Components is
Expr : Node_Id; Expr : Node_Id;
...@@ -3777,15 +3789,16 @@ package body Exp_Aggr is ...@@ -3777,15 +3789,16 @@ package body Exp_Aggr is
else else
Choice_Index := UI_To_Int (Expr_Value (Choice)); Choice_Index := UI_To_Int (Expr_Value (Choice));
if Choice_Index in Vals'Range then if Choice_Index in Vals'Range then
Vals (Choice_Index) := Vals (Choice_Index) :=
New_Copy_Tree (Expression (Elmt)); New_Copy_Tree (Expression (Elmt));
goto Continue; goto Continue;
else -- Choice is statically out-of-range, will be
-- Choice is statically out-of-range, will be -- rewritten to raise Constraint_Error.
-- rewritten to raise Constraint_Error.
else
return False; return False;
end if; end if;
end if; end if;
...@@ -3798,6 +3811,7 @@ package body Exp_Aggr is ...@@ -3798,6 +3811,7 @@ package body Exp_Aggr is
not Compile_Time_Known_Value (Hi) not Compile_Time_Known_Value (Hi)
then then
return False; return False;
else else
for J in UI_To_Int (Expr_Value (Lo)) .. for J in UI_To_Int (Expr_Value (Lo)) ..
UI_To_Int (Expr_Value (Hi)) UI_To_Int (Expr_Value (Hi))
...@@ -4175,7 +4189,8 @@ package body Exp_Aggr is ...@@ -4175,7 +4189,8 @@ package body Exp_Aggr is
end if; end if;
Remainder := Value rem 2**System_Storage_Unit; Remainder := Value rem 2**System_Storage_Unit;
for I in 1 .. Nunits - 1 loop
for J in 1 .. Nunits - 1 loop
Value := Value / 2**System_Storage_Unit; Value := Value / 2**System_Storage_Unit;
if Value rem 2**System_Storage_Unit /= Remainder then if Value rem 2**System_Storage_Unit /= Remainder then
...@@ -4240,7 +4255,7 @@ package body Exp_Aggr is ...@@ -4240,7 +4255,7 @@ package body Exp_Aggr is
Decl := Decl :=
Make_Full_Type_Declaration (Loc, Make_Full_Type_Declaration (Loc,
Defining_Identifier => Agg_Type, Defining_Identifier => Agg_Type,
Type_Definition => Type_Definition =>
Make_Constrained_Array_Definition (Loc, Make_Constrained_Array_Definition (Loc,
Discrete_Subtype_Definitions => Indexes, Discrete_Subtype_Definitions => Indexes,
Component_Definition => Component_Definition =>
...@@ -4274,7 +4289,7 @@ package body Exp_Aggr is ...@@ -4274,7 +4289,7 @@ package body Exp_Aggr is
Get_Index_Bounds (Index_Bounds, Ind_Lo, Ind_Hi); Get_Index_Bounds (Index_Bounds, Ind_Lo, Ind_Hi);
-- Generate the following test: -- Generate the following test:
--
-- [constraint_error when -- [constraint_error when
-- Aggr_Lo <= Aggr_Hi and then -- Aggr_Lo <= Aggr_Hi and then
-- (Aggr_Lo < Ind_Lo or else Aggr_Hi > Ind_Hi)] -- (Aggr_Lo < Ind_Lo or else Aggr_Hi > Ind_Hi)]
...@@ -4364,8 +4379,7 @@ package body Exp_Aggr is ...@@ -4364,8 +4379,7 @@ package body Exp_Aggr is
if Index_Checks_Suppressed (Ind_Typ) then if Index_Checks_Suppressed (Ind_Typ) then
Cond := Empty; Cond := Empty;
elsif Dim = 1 elsif Dim = 1 or else (Aggr_Lo = Sub_Lo and then Aggr_Hi = Sub_Hi)
or else (Aggr_Lo = Sub_Lo and then Aggr_Hi = Sub_Hi)
then then
Cond := Empty; Cond := Empty;
...@@ -4588,12 +4602,12 @@ package body Exp_Aggr is ...@@ -4588,12 +4602,12 @@ package body Exp_Aggr is
-- Start of processing for Safe_Component -- Start of processing for Safe_Component
begin begin
-- If the component appears in an association that may -- If the component appears in an association that may correspond
-- correspond to more than one element, it is not analyzed -- to more than one element, it is not analyzed before expansion
-- before the expansion into assignments, to avoid side effects. -- into assignments, to avoid side effects. We analyze, but do not
-- We analyze, but do not resolve the copy, to obtain sufficient -- resolve the copy, to obtain sufficient entity information for
-- entity information for the checks that follow. If component is -- the checks that follow. If component is overloaded we assume
-- overloaded we assume an unsafe function call. -- an unsafe function call.
if not Analyzed (Comp) then if not Analyzed (Comp) then
if Is_Overloaded (Expr) then if Is_Overloaded (Expr) then
...@@ -4632,9 +4646,9 @@ package body Exp_Aggr is ...@@ -4632,9 +4646,9 @@ package body Exp_Aggr is
-- assignment in place unless the bounds of the aggregate are -- assignment in place unless the bounds of the aggregate are
-- statically equal to those of the target. -- statically equal to those of the target.
-- If the aggregate is given by an others choice, the bounds -- If the aggregate is given by an others choice, the bounds are
-- are derived from the left-hand side, and the assignment is -- derived from the left-hand side, and the assignment is safe if
-- safe if the expression is. -- the expression is.
if Is_Others_Aggregate (N) then if Is_Others_Aggregate (N) then
return return
...@@ -4648,8 +4662,8 @@ package body Exp_Aggr is ...@@ -4648,8 +4662,8 @@ package body Exp_Aggr is
Obj_In := First_Index (Etype (Name (Parent (N)))); Obj_In := First_Index (Etype (Name (Parent (N))));
else else
-- Context is an allocator. Check bounds of aggregate -- Context is an allocator. Check bounds of aggregate against
-- against given type in qualified expression. -- given type in qualified expression.
pragma Assert (Nkind (Parent (Parent (N))) = N_Allocator); pragma Assert (Nkind (Parent (Parent (N))) = N_Allocator);
Obj_In := Obj_In :=
...@@ -4733,6 +4747,8 @@ package body Exp_Aggr is ...@@ -4733,6 +4747,8 @@ package body Exp_Aggr is
-- Count the number of discrete choices. Start with -1 because -- Count the number of discrete choices. Start with -1 because
-- the others choice does not count. -- the others choice does not count.
-- Is there some reason we do not use List_Length here ???
Nb_Choices := -1; Nb_Choices := -1;
Assoc := First (Component_Associations (Sub_Aggr)); Assoc := First (Component_Associations (Sub_Aggr));
while Present (Assoc) loop while Present (Assoc) loop
...@@ -4834,7 +4850,7 @@ package body Exp_Aggr is ...@@ -4834,7 +4850,7 @@ package body Exp_Aggr is
Expressions => Expressions =>
New_List New_List
(Duplicate_Subexpr_Move_Checks (Aggr_Lo))), (Duplicate_Subexpr_Move_Checks (Aggr_Lo))),
Right_Opnd => Make_Integer_Literal (Loc, Nb_Elements - 1)), Right_Opnd => Make_Integer_Literal (Loc, Nb_Elements - 1)),
Right_Opnd => Right_Opnd =>
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
...@@ -4854,17 +4870,13 @@ package body Exp_Aggr is ...@@ -4854,17 +4870,13 @@ package body Exp_Aggr is
Make_Or_Else (Loc, Make_Or_Else (Loc,
Left_Opnd => Left_Opnd =>
Make_Op_Lt (Loc, Make_Op_Lt (Loc,
Left_Opnd => Left_Opnd => Duplicate_Subexpr_Move_Checks (Choices_Lo),
Duplicate_Subexpr_Move_Checks (Choices_Lo), Right_Opnd => Duplicate_Subexpr_Move_Checks (Aggr_Lo)),
Right_Opnd =>
Duplicate_Subexpr_Move_Checks (Aggr_Lo)),
Right_Opnd => Right_Opnd =>
Make_Op_Gt (Loc, Make_Op_Gt (Loc,
Left_Opnd => Left_Opnd => Duplicate_Subexpr (Choices_Hi),
Duplicate_Subexpr (Choices_Hi), Right_Opnd => Duplicate_Subexpr (Aggr_Hi)));
Right_Opnd =>
Duplicate_Subexpr (Aggr_Hi)));
end if; end if;
if Present (Cond) then if Present (Cond) then
...@@ -5027,12 +5039,12 @@ package body Exp_Aggr is ...@@ -5027,12 +5039,12 @@ package body Exp_Aggr is
Compute_Others_Present (N, 1); Compute_Others_Present (N, 1);
for J in 1 .. Aggr_Dimension loop for J in 1 .. Aggr_Dimension loop
-- There is no need to emit a check if an others choice is -- There is no need to emit a check if an others choice is present
-- present for this array aggregate dimension since in this -- for this array aggregate dimension since in this case one of
-- case one of N's sub-aggregates has taken its bounds from the -- N's sub-aggregates has taken its bounds from the context and
-- context and these bounds must have been checked already. In -- these bounds must have been checked already. In addition all
-- addition all sub-aggregates corresponding to the same -- sub-aggregates corresponding to the same dimension must all
-- dimension must all have the same bounds (checked in (c) below). -- have the same bounds (checked in (c) below).
if not Range_Checks_Suppressed (Etype (Index_Constraint)) if not Range_Checks_Suppressed (Etype (Index_Constraint))
and then not Others_Present (J) and then not Others_Present (J)
...@@ -5261,8 +5273,8 @@ package body Exp_Aggr is ...@@ -5261,8 +5273,8 @@ package body Exp_Aggr is
(Nkind (Parent (N)) = N_Assignment_Statement (Nkind (Parent (N)) = N_Assignment_Statement
and then In_Place_Assign_OK) and then In_Place_Assign_OK)
or else or else
(Nkind (Parent (Parent (N))) = N_Allocator (Nkind (Parent (Parent (N))) = N_Allocator
and then In_Place_Assign_OK); and then In_Place_Assign_OK);
end if; end if;
...@@ -5365,10 +5377,9 @@ package body Exp_Aggr is ...@@ -5365,10 +5377,9 @@ package body Exp_Aggr is
Maybe_In_Place_OK := False; Maybe_In_Place_OK := False;
Tmp := Make_Temporary (Loc, 'A', N); Tmp := Make_Temporary (Loc, 'A', N);
Tmp_Decl := Tmp_Decl :=
Make_Object_Declaration Make_Object_Declaration (Loc,
(Loc, Defining_Identifier => Tmp,
Defining_Identifier => Tmp, Object_Definition => New_Occurrence_Of (Typ, Loc));
Object_Definition => New_Occurrence_Of (Typ, Loc));
Set_No_Initialization (Tmp_Decl, True); Set_No_Initialization (Tmp_Decl, True);
-- If we are within a loop, the temporary will be pushed on the -- If we are within a loop, the temporary will be pushed on the
...@@ -5398,7 +5409,6 @@ package body Exp_Aggr is ...@@ -5398,7 +5409,6 @@ package body Exp_Aggr is
Target := New_Occurrence_Of (Tmp, Loc); Target := New_Occurrence_Of (Tmp, Loc);
else else
if Has_Default_Init_Comps (N) then if Has_Default_Init_Comps (N) then
-- Ada 2005 (AI-287): This case has not been analyzed??? -- Ada 2005 (AI-287): This case has not been analyzed???
...@@ -5606,6 +5616,7 @@ package body Exp_Aggr is ...@@ -5606,6 +5616,7 @@ package body Exp_Aggr is
Expand_Array_Aggregate (N); Expand_Array_Aggregate (N);
end if; end if;
exception exception
when RE_Not_Available => when RE_Not_Available =>
return; return;
...@@ -5887,11 +5898,11 @@ package body Exp_Aggr is ...@@ -5887,11 +5898,11 @@ package body Exp_Aggr is
-- Start of processing for Expand_Record_Aggregate -- Start of processing for Expand_Record_Aggregate
begin begin
-- If the aggregate is to be assigned to an atomic variable, we -- If the aggregate is to be assigned to an atomic variable, we have
-- have to prevent a piecemeal assignment even if the aggregate -- to prevent a piecemeal assignment even if the aggregate is to be
-- is to be expanded. We create a temporary for the aggregate, and -- expanded. We create a temporary for the aggregate, and assign the
-- assign the temporary instead, so that the back end can generate -- temporary instead, so that the back end can generate an atomic move
-- an atomic move for it. -- for it.
if Is_Atomic (Typ) if Is_Atomic (Typ)
and then Comes_From_Source (Parent (N)) and then Comes_From_Source (Parent (N))
...@@ -6054,9 +6065,9 @@ package body Exp_Aggr is ...@@ -6054,9 +6065,9 @@ package body Exp_Aggr is
New_List (New_Occurrence_Of (Discriminant, Loc)), New_List (New_Occurrence_Of (Discriminant, Loc)),
Expression => Expression =>
New_Copy_Tree ( New_Copy_Tree
Get_Discriminant_Value ( (Get_Discriminant_Value
Discriminant, (Discriminant,
Typ, Typ,
Discriminant_Constraint (Typ)))); Discriminant_Constraint (Typ))));
...@@ -6081,8 +6092,7 @@ package body Exp_Aggr is ...@@ -6081,8 +6092,7 @@ package body Exp_Aggr is
Comp := First_Comp; Comp := First_Comp;
Next (First_Comp); Next (First_Comp);
if Ekind (Entity if Ekind (Entity (First (Choices (Comp)))) = E_Discriminant
(First (Choices (Comp)))) = E_Discriminant
then then
Remove (Comp); Remove (Comp);
Num_Disc := Num_Disc + 1; Num_Disc := Num_Disc + 1;
...@@ -6120,8 +6130,8 @@ package body Exp_Aggr is ...@@ -6120,8 +6130,8 @@ package body Exp_Aggr is
New_Copy_Tree New_Copy_Tree
(Get_Discriminant_Value (Get_Discriminant_Value
(Discriminant, (Discriminant,
Typ, Typ,
Discriminant_Constraint (Typ))); Discriminant_Constraint (Typ)));
Append (New_Comp, Constraints); Append (New_Comp, Constraints);
Next_Stored_Discriminant (Discriminant); Next_Stored_Discriminant (Discriminant);
end loop; end loop;
...@@ -6129,11 +6139,11 @@ package body Exp_Aggr is ...@@ -6129,11 +6139,11 @@ package body Exp_Aggr is
Decl := Decl :=
Make_Subtype_Declaration (Loc, Make_Subtype_Declaration (Loc,
Defining_Identifier => Make_Temporary (Loc, 'T'), Defining_Identifier => Make_Temporary (Loc, 'T'),
Subtype_Indication => Subtype_Indication =>
Make_Subtype_Indication (Loc, Make_Subtype_Indication (Loc,
Subtype_Mark => Subtype_Mark =>
New_Occurrence_Of (Etype (Base_Type (Typ)), Loc), New_Occurrence_Of (Etype (Base_Type (Typ)), Loc),
Constraint => Constraint =>
Make_Index_Or_Discriminant_Constraint Make_Index_Or_Discriminant_Constraint
(Loc, Constraints))); (Loc, Constraints)));
...@@ -6175,18 +6185,16 @@ package body Exp_Aggr is ...@@ -6175,18 +6185,16 @@ package body Exp_Aggr is
-- Skip all expander-generated components -- Skip all expander-generated components
if if not Comes_From_Source (Original_Record_Component (Comp))
not Comes_From_Source (Original_Record_Component (Comp))
then then
null; null;
else else
New_Comp := New_Comp :=
Make_Selected_Component (Loc, Make_Selected_Component (Loc,
Prefix => Prefix =>
Unchecked_Convert_To (Typ, Unchecked_Convert_To (Typ,
Duplicate_Subexpr (Parent_Expr, True)), Duplicate_Subexpr (Parent_Expr, True)),
Selector_Name => New_Occurrence_Of (Comp, Loc)); Selector_Name => New_Occurrence_Of (Comp, Loc));
Append_To (Comps, Append_To (Comps,
...@@ -6311,6 +6319,7 @@ package body Exp_Aggr is ...@@ -6311,6 +6319,7 @@ package body Exp_Aggr is
Comps : constant List_Id := Component_Associations (N); Comps : constant List_Id := Component_Associations (N);
C : Node_Id; C : Node_Id;
Expr : Node_Id; Expr : Node_Id;
begin begin
pragma Assert (Nkind_In (N, N_Aggregate, N_Extension_Aggregate)); pragma Assert (Nkind_In (N, N_Aggregate, N_Extension_Aggregate));
...@@ -6471,7 +6480,6 @@ package body Exp_Aggr is ...@@ -6471,7 +6480,6 @@ package body Exp_Aggr is
is is
begin begin
Set_Assignment_OK (Name); Set_Assignment_OK (Name);
return Make_Assignment_Statement (Sloc, Name, Expression); return Make_Assignment_Statement (Sloc, Name, Expression);
end Make_OK_Assignment_Statement; end Make_OK_Assignment_Statement;
...@@ -6977,14 +6985,12 @@ package body Exp_Aggr is ...@@ -6977,14 +6985,12 @@ package body Exp_Aggr is
Incr := +Comp_Size; Incr := +Comp_Size;
end if; end if;
Shift := Init_Shift;
One_Dim := First (Expressions (N));
-- Iterate over each subaggregate -- Iterate over each subaggregate
Shift := Init_Shift;
One_Dim := First (Expressions (N));
while Present (One_Dim) loop while Present (One_Dim) loop
One_Comp := First (Expressions (One_Dim)); One_Comp := First (Expressions (One_Dim));
while Present (One_Comp) loop while Present (One_Comp) loop
if Packed_Num = Byte_Size / Comp_Size then if Packed_Num = Byte_Size / Comp_Size then
...@@ -7026,8 +7032,7 @@ package body Exp_Aggr is ...@@ -7026,8 +7032,7 @@ package body Exp_Aggr is
Unchecked_Convert_To (Typ, Unchecked_Convert_To (Typ,
Make_Qualified_Expression (Loc, Make_Qualified_Expression (Loc,
Subtype_Mark => New_Occurrence_Of (Packed_Array, Loc), Subtype_Mark => New_Occurrence_Of (Packed_Array, Loc),
Expression => Expression => Make_Aggregate (Loc, Expressions => Comps))));
Make_Aggregate (Loc, Expressions => Comps))));
Analyze_And_Resolve (N); Analyze_And_Resolve (N);
return True; return True;
end; end;
......
gcc/ada/gnat_ugn.texi
...@@ -14140,10 +14140,9 @@ tool argument. ...@@ -14140,10 +14140,9 @@ tool argument.
Incremental processing on a per-file basis. Source files are only Incremental processing on a per-file basis. Source files are only
processed if they have been modified, or if files they depend on have processed if they have been modified, or if files they depend on have
been modified. This is similar to the way gnatmake/gprbuild only been modified. This is similar to the way gnatmake/gprbuild only
compiles files that need to be recompiled. Note that in this mode compiles files that need to be recompiled. A project file is required
@command{gnatpp} is acting in place of the compiler, so if a project in this mode, and the gnat driver (as in @command{gnat pretty}) is not
file is used, the switches set for the compiler should not be set supported.
to switches recognized by @command{gcc}.
@item --pp-off=@var{xxx} @item --pp-off=@var{xxx}
@cindex @option{--pp-off} @command{gnatpp} @cindex @option{--pp-off} @command{gnatpp}
...@@ -14577,10 +14576,8 @@ options: ...@@ -14577,10 +14576,8 @@ options:
--incremental -- incremental processing on a per-file basis. Source files are --incremental -- incremental processing on a per-file basis. Source files are
only processed if they have been modified, or if files they depend only processed if they have been modified, or if files they depend
on have been modified. This is similar to the way gnatmake/gprbuild on have been modified. This is similar to the way gnatmake/gprbuild
only compiles files that need to be recompiled. Note that in this mode only compiles files that need to be recompiled. A project file
@command{gnat2xml} is acting in place of the compiler, so if a project is required in this mode.
file is used, the switches set for the compiler should not be set
to switches recognized by @command{gcc}.
-j@var{n} -- In @option{--incremental} mode, use @var{n} @command{gnat2xml} -j@var{n} -- In @option{--incremental} mode, use @var{n} @command{gnat2xml}
processes to perform XML generation in parallel. If @var{n} is 0, then processes to perform XML generation in parallel. If @var{n} is 0, then
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment