+2014-01-22 Robert Dewar <dewar@adacore.com>
+
+ * sem_prag.adb (Analyze_Initializes_In_Decl_Part): Handle null
+ initializes case.
+
+2014-01-22 Robert Dewar <dewar@adacore.com>
+
+ * snames.ads-tmpl: Update header.
+
+2014-01-22 Thomas Quinot <quinot@adacore.com>
+
+ * exp_util.adb (Insert_Actions): When inserting actions on a
+ short circuit operator that has already been analyzed, do not park
+ actions in node; instead introduce an N_Expression_With_Actions
+ and insert actions immediately.
+ Add guard for unexpected case of climbing up through statement
+ in Actions list of an N_Expression_With_Actions.
+ * sem_elab.adb (Insert_Elab_Check): Remove complex
+ specialized circuitry for the case where the context is already
+ analyzed, as it is not needed and introduces irregularities in
+ finalization. Instead rely on the above change to Insert_Actions
+ to ensure that late insertion on short circuit operators works
+ as expected.
+
+2014-01-22 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch4.adb (Operator_Check): Improve error message when an
+ operand of concatenation is an access type.
+
+2014-01-22 Thomas Quinot <quinot@adacore.com>
+
+ * sem_dim.adb (Analyze_Dimension_Identifier): Add guard against
+ cascaded error.
+
+2014-01-22 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch8.adb (Find_Selected_Component): Handle properly the case
+ of an expanded name in a proper body, whose prefix is a package
+ in the context of the proper body, when there is a homonym of
+ the package declared in the parent unit.
+
2014-01-22 Robert Dewar <dewar@adacore.com>
* sem_warn.adb (Check_Use_Clause): Don't give no entities used
Kill_Current_Values;
- if Present (Actions (P)) then
+ -- If P has already been expanded, we can't park new actions
+ -- on it, so we need to expand them immediately, introducing
+ -- an Expression_With_Actions. N can't be an expression
+ -- with actions, or else then the actions would have been
+ -- inserted at an inner level.
+
+ if Analyzed (P) then
+ pragma Assert (Nkind (N) /= N_Expression_With_Actions);
+ Rewrite (N,
+ Make_Expression_With_Actions (Sloc (N),
+ Actions => Ins_Actions,
+ Expression => Relocate_Node (N)));
+ Analyze_And_Resolve (N);
+
+ elsif Present (Actions (P)) then
Insert_List_After_And_Analyze
(Last (Actions (P)), Ins_Actions);
else
-- the new actions come from the expression of the expression with
-- actions, they must be added to the existing actions. The other
-- alternative is when the new actions are related to one of the
- -- existing actions of the expression with actions. In that case
- -- they must be inserted further up the tree.
+ -- existing actions of the expression with actions, and should
+ -- never reach here: if actions are inserted on a statement within
+ -- the Actions of an expression with actions, or on some
+ -- sub-expression of such a statement, then the outermost proper
+ -- insertion point is right before the statement, and we should
+ -- never climb up as far as the N_Expression_With_Actions itself.
when N_Expression_With_Actions =>
if N = Expression (P) then
(Last (Actions (P)), Ins_Actions);
end if;
return;
+
+ else
+ raise Program_Error;
end if;
-- Case of appearing in the condition of a while expression or
-- In an instance a generic actual may be a numeric type even if
-- the formal in the generic unit was not. In that case, the
-- predefined operator was not a possible interpretation in the
- -- generic, and cannot be one in the instance.
+ -- generic, and cannot be one in the instance, unless the operator
+ -- is an actual of an instance.
if In_Instance
and then
if Nkind (N) /= N_Op_Concat then
Error_Msg_NE ("\left operand has}!", N, Etype (L));
Error_Msg_NE ("\right operand has}!", N, Etype (R));
+
+ -- For concatenation operators it is more difficult to
+ -- determine which is the wrong operand. It is worth
+ -- flagging explicitly an access type, for those who
+ -- might think that a dereference happens here.
+
+ elsif Is_Access_Type (Etype (L)) then
+ Error_Msg_N ("\left operand is access type", N);
+
+ elsif Is_Access_Type (Etype (R)) then
+ Error_Msg_N ("\right operand is access type", N);
end if;
end if;
end if;
Nam : Node_Id;
+ function Is_Reference_In_Subunit return Boolean;
+ -- In a subunit, the scope depth is not a proper measure of hiding,
+ -- because the context of the proper body may itself hide entities in
+ -- parent units. This rare case requires inspecting the tree directly
+ -- because the proper body is inserted in the main unit and its context
+ -- is simply added to that of the parent.
+
+ -----------------------------
+ -- Is_Reference_In_Subunit --
+ -----------------------------
+
+ function Is_Reference_In_Subunit return Boolean is
+ Clause : Node_Id;
+ Comp_Unit : Node_Id;
+
+ begin
+ Comp_Unit := N;
+ while Present (Comp_Unit)
+ and then Nkind (Comp_Unit) /= N_Compilation_Unit
+ loop
+ Comp_Unit := Parent (Comp_Unit);
+ end loop;
+
+ if No (Comp_Unit)
+ or else Nkind (Unit (Comp_Unit)) /= N_Subunit
+ then
+ return False;
+ end if;
+
+ -- Now check whether the package is in the context of the subunit
+
+ Clause := First (Context_Items (Comp_Unit));
+
+ while Present (Clause) loop
+ if Nkind (Clause) = N_With_Clause
+ and then Entity (Name (Clause)) = P_Name
+ then
+ return True;
+ end if;
+
+ Clause := Next (Clause);
+ end loop;
+
+ return False;
+ end Is_Reference_In_Subunit;
+
begin
Analyze (P);
end loop;
if Present (P_Name) then
- Error_Msg_Sloc := Sloc (Entity (Prefix (N)));
+ if not Is_Reference_In_Subunit then
+ Error_Msg_Sloc := Sloc (Entity (Prefix (N)));
- Error_Msg_NE
- ("package& is hidden by declaration#",
- N, P_Name);
+ Error_Msg_NE
+ ("package& is hidden by declaration#",
+ N, P_Name);
+ end if;
Set_Entity (Prefix (N), P_Name);
Find_Expanded_Name (N);
Analyze_Dimension_Identifier : declare
Id : constant Entity_Id := Entity (N);
begin
- if Ekind (Id) = E_Constant
+ if No (Id) then
+ -- Abnormal tree, assume previous error
+
+ Check_Error_Detected;
+ return;
+
+ elsif Ekind (Id) = E_Constant
and then Exists (Dimensions_Of (Id))
then
Set_Dimensions (N, Dimensions_Of (Id));
with Sem_Cat; use Sem_Cat;
with Sem_Ch7; use Sem_Ch7;
with Sem_Ch8; use Sem_Ch8;
-with Sem_Res; use Sem_Res;
-with Sem_Type; use Sem_Type;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
with Sinput; use Sinput;
Nod : Node_Id;
Loc : constant Source_Ptr := Sloc (N);
+ Chk : Node_Id;
+ -- The check (N_Raise_Program_Error) node to be inserted
+
begin
-- If expansion is disabled, do not generate any checks. Also
-- skip checks if any subunits are missing because in either
Nod := N;
end if;
+ -- Build check node, possibly with condition
+
+ Chk := Make_Raise_Program_Error (Loc,
+ Reason => PE_Access_Before_Elaboration);
+ if Present (C) then
+ Set_Condition (Chk,
+ Make_Op_Not (Loc, Right_Opnd => C));
+ end if;
+
-- If we are inserting at the top level, insert in Aux_Decls
if Nkind (Parent (Nod)) = N_Compilation_Unit then
declare
ADN : constant Node_Id := Aux_Decls_Node (Parent (Nod));
- R : Node_Id;
begin
- if No (C) then
- R :=
- Make_Raise_Program_Error (Loc,
- Reason => PE_Access_Before_Elaboration);
- else
- R :=
- Make_Raise_Program_Error (Loc,
- Condition => Make_Op_Not (Loc, C),
- Reason => PE_Access_Before_Elaboration);
- end if;
-
if No (Declarations (ADN)) then
- Set_Declarations (ADN, New_List (R));
+ Set_Declarations (ADN, New_List (Chk));
else
- Append_To (Declarations (ADN), R);
+ Append_To (Declarations (ADN), Chk);
end if;
- Analyze (R);
+ Analyze (Chk);
end;
- -- Otherwise just insert before the node in question. However, if
- -- the context of the call has already been analyzed, an insertion
- -- will not work if it depends on subsequent expansion (e.g. a call in
- -- a branch of a short-circuit). In that case we replace the call with
- -- an if expression, or with a Raise if it is unconditional.
-
- -- Unfortunately this does not work if the call has a dynamic size,
- -- because gigi regards it as a dynamic-sized temporary. If such a call
- -- appears in a short-circuit expression, the elaboration check will be
- -- missed (rare enough ???). Otherwise, the code below inserts the check
- -- at the appropriate place before the call. Same applies in the even
- -- rarer case the return type has a known size but is unconstrained.
+ -- Otherwise just insert as an action on the node in question
else
- if Nkind (N) = N_Function_Call
- and then Analyzed (Parent (N))
- and then Size_Known_At_Compile_Time (Etype (N))
- and then
- (not Has_Discriminants (Etype (N))
- or else Is_Constrained (Etype (N)))
-
- then
- declare
- Typ : constant Entity_Id := Etype (N);
- Chk : constant Boolean := Do_Range_Check (N);
-
- R : constant Node_Id :=
- Make_Raise_Program_Error (Loc,
- Reason => PE_Access_Before_Elaboration);
-
- Reloc_N : Node_Id;
-
- begin
- Set_Etype (R, Typ);
-
- if No (C) then
- Rewrite (N, R);
-
- else
- Reloc_N := Relocate_Node (N);
- Save_Interps (N, Reloc_N);
- Rewrite (N,
- Make_If_Expression (Loc,
- Expressions => New_List (C, Reloc_N, R)));
- end if;
-
- Analyze_And_Resolve (N, Typ);
-
- -- If the original call requires a range check, so does the
- -- if expression.
-
- if Chk then
- Enable_Range_Check (N);
- else
- Set_Do_Range_Check (N, False);
- end if;
- end;
-
- else
- if No (C) then
- Insert_Action (Nod,
- Make_Raise_Program_Error (Loc,
- Reason => PE_Access_Before_Elaboration));
- else
- Insert_Action (Nod,
- Make_Raise_Program_Error (Loc,
- Condition =>
- Make_Op_Not (Loc,
- Right_Opnd => C),
- Reason => PE_Access_Before_Elaboration));
- end if;
- end if;
+ Insert_Action (Nod, Chk);
end if;
end Insert_Elab_Check;
Collect_States_And_Variables;
+ -- All done if result is null
+
+ if Nkind (Inits) = N_Null then
+ return;
+ end if;
+
-- Single and multiple initialization clauses must appear as an
- -- aggregate. If this is not the case, then either the parser of
+ -- aggregate. If this is not the case, then either the parser or
-- the analysis of the pragma failed to produce an aggregate.
pragma Assert (Nkind (Inits) = N_Aggregate);
-- --
-- S N A M E S --
-- --
--- T e m p l a t e --
+-- S p e c --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- --
projects / thirdparty / gcc.git / commitdiff
