Commit a52e6d7e by Arnaud Charlet

[multiple changes]

2013-01-29  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Analyze_Expression_Function): An expression
	function declaration is not a subprogram declaration, and thus
	cannot appear in a protected definition.

2013-01-29  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_util.adb (Insert_Actions): When new
	actions come from the expression of the expression with actions,
	then they must be added to the list of existing actions.

2013-01-29  Eric Botcazou  <ebotcazou@adacore.com>

	* sem_ch3.adb (Analyze_Subtype_Declaration) <Private_Kind>: For
	the subtype of a constrained private type with discriminants
	that has got a full view, show that the completion is a clone
	of the full view.

From-SVN: r195543
parent 78d087bc
2013-01-29 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Analyze_Expression_Function): An expression
function declaration is not a subprogram declaration, and thus
cannot appear in a protected definition.
2013-01-29 Hristian Kirtchev <kirtchev@adacore.com>
* exp_util.adb (Insert_Actions): When new
actions come from the expression of the expression with actions,
then they must be added to the list of existing actions.
2013-01-29 Eric Botcazou <ebotcazou@adacore.com>
* sem_ch3.adb (Analyze_Subtype_Declaration) <Private_Kind>: For
the subtype of a constrained private type with discriminants
that has got a full view, show that the completion is a clone
of the full view.
2013-01-29 Javier Miranda <miranda@adacore.com>
* errout.ads, errout.adb (Get_Ignore_Errors): New subprogram.
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- --
-- 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- --
......@@ -3141,25 +3141,27 @@ package body Exp_Util is
-- N_Raise_xxx_Error is an annoying special case, it is a statement if
-- it has type Standard_Void_Type, and a subexpression otherwise.
-- otherwise. Procedure attribute references are also statements.
-- otherwise. Procedure calls, and similarly procedure attribute
-- references, are also statements.
if Nkind (Assoc_Node) in N_Subexpr
and then (Nkind (Assoc_Node) in N_Raise_xxx_Error
and then (Nkind (Assoc_Node) not in N_Raise_xxx_Error
or else Etype (Assoc_Node) /= Standard_Void_Type)
and then Nkind (Assoc_Node) /= N_Procedure_Call_Statement
and then (Nkind (Assoc_Node) /= N_Attribute_Reference
or else
not Is_Procedure_Attribute_Name
(Attribute_Name (Assoc_Node)))
then
P := Assoc_Node; -- ??? does not agree with above!
N := Parent (Assoc_Node);
N := Assoc_Node;
P := Parent (Assoc_Node);
-- Non-subexpression case. Note that N is initially Empty in this case
-- (N is only guaranteed Non-Empty in the subexpr case).
else
P := Assoc_Node;
N := Empty;
P := Assoc_Node;
end if;
-- Capture root of the transient scope
......@@ -3171,6 +3173,13 @@ package body Exp_Util is
loop
pragma Assert (Present (P));
-- Make sure that inserted actions stay in the transient scope
if Present (Wrapped_Node) and then N = Wrapped_Node then
Store_Before_Actions_In_Scope (Ins_Actions);
return;
end if;
case Nkind (P) is
-- Case of right operand of AND THEN or OR ELSE. Put the actions
......@@ -3282,14 +3291,17 @@ package body Exp_Util is
return;
-- Case of appearing within an Expressions_With_Actions node. We
-- append the actions to the list of actions already there, if
-- the node has not been analyzed yet. Otherwise find insertion
-- location further up the tree.
-- Case of appearing within an Expressions_With_Actions node. When
-- 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.
when N_Expression_With_Actions =>
if not Analyzed (P) then
Append_List (Ins_Actions, Actions (P));
if N = Expression (P) then
Insert_List_After_And_Analyze
(Last (Actions (P)), Ins_Actions);
return;
end if;
......@@ -3697,13 +3709,6 @@ package body Exp_Util is
end case;
-- Make sure that inserted actions stay in the transient scope
if P = Wrapped_Node then
Store_Before_Actions_In_Scope (Ins_Actions);
return;
end if;
-- If we fall through above tests, keep climbing tree
N := P;
......
......@@ -4282,14 +4282,27 @@ package body Sem_Ch3 is
Set_Stored_Constraint_From_Discriminant_Constraint (Id);
-- This would seem semantically correct, but apparently
-- confuses the back-end. To be explained and checked with
-- current version ???
-- generates spurious errors about missing components ???
-- Set_Has_Discriminants (Id);
end if;
Prepare_Private_Subtype_Completion (Id, N);
-- If this is the subtype of a constrained private type with
-- discriminants that has got a full view and we also have
-- built a completion just above, show that the completion
-- is a clone of the full view to the back-end.
if Has_Discriminants (T)
and then not Has_Unknown_Discriminants (T)
and then not Is_Empty_Elmt_List (Discriminant_Constraint (T))
and then Present (Full_View (T))
and then Present (Full_View (Id))
then
Set_Cloned_Subtype (Full_View (Id), Full_View (T));
end if;
when Access_Kind =>
Set_Ekind (Id, E_Access_Subtype);
Set_Is_Constrained (Id, Is_Constrained (T));
......
......@@ -408,6 +408,15 @@ package body Sem_Ch6 is
-- that the expression can be inlined whenever possible.
else
-- An expression function that is not a completion is not a
-- subprogram declaration, and thus cannot appear in a protected
-- definition.
if Nkind (Parent (N)) = N_Protected_Definition then
Error_Msg_N
("an expression function is not a legal protected operation", N);
end if;
New_Decl :=
Make_Subprogram_Declaration (Loc, Specification => Spec);
......
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