Commit 466c2127 by Arnaud Charlet

[multiple changes]

2013-07-08  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch9.adb (Expand_N_Asynchronous_Select): If the trigger
	of the asynchronous select is a dispatching call, transform the
	abortable part into a procedure, to avoid duplication of local
	loop variables that may appear within.

2013-07-08  Vincent Celier  <celier@adacore.com>

	* projects.texi: Update the documentation of suffixes in package
	Naming.

2013-07-08  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Conforming_Types): Anonymous_access_to_subprograsm
	types are type conformant if the designated type of one is
	protected and the other is not. Convention only matters when
	checking subtype conformance.

2013-07-08  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Make_Call_Into_Operator): In ASIS mode, propagate
	back the fully resolved operands to the original function call
	so that all semantic information remains available to ASIS.

From-SVN: r200767
parent 7b23a7ac
2013-07-08 Ed Schonberg <schonberg@adacore.com>
* exp_ch9.adb (Expand_N_Asynchronous_Select): If the trigger
of the asynchronous select is a dispatching call, transform the
abortable part into a procedure, to avoid duplication of local
loop variables that may appear within.
2013-07-08 Vincent Celier <celier@adacore.com>
* projects.texi: Update the documentation of suffixes in package
Naming.
2013-07-08 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Conforming_Types): Anonymous_access_to_subprograsm
types are type conformant if the designated type of one is
protected and the other is not. Convention only matters when
checking subtype conformance.
2013-07-08 Ed Schonberg <schonberg@adacore.com>
* sem_res.adb (Make_Call_Into_Operator): In ASIS mode, propagate
back the fully resolved operands to the original function call
so that all semantic information remains available to ASIS.
2013-07-08 Ed Schonberg <schonberg@adacore.com>
* sem_ch4.adb: minor reformatting (remove obsolete comment).
* sem_ch9.adb: improve error message on illegal trigger.
......
......@@ -6756,6 +6756,40 @@ package body Exp_Ch9 is
S : Entity_Id; -- Primitive operation slot
T : Entity_Id; -- Additional status flag
procedure Rewrite_Abortable_Part;
-- If the trigger is a dispatching call, the expansion inserts multiple
-- copies of the abortable part. This is both inefficient, and may lead
-- to duplicate definitions that the back-end will reject, when the
-- abortable part includes loops. This procedure rewrites the abortable
-- part into a call to a generated procedure.
----------------------------
-- Rewrite_Abortable_Part --
----------------------------
procedure Rewrite_Abortable_Part is
Proc : constant Entity_Id := Make_Defining_Identifier (Loc, Name_uA);
Decl : Node_Id;
begin
Decl :=
Make_Subprogram_Body (Loc,
Specification =>
Make_Procedure_Specification (Loc, Defining_Unit_Name => Proc),
Declarations => New_List,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc, Astats));
Insert_Before (N, Decl);
Analyze (Decl);
-- Rewrite abortable part into a call to this procedure.
Astats :=
New_List (
Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (Proc, Loc)));
end Rewrite_Abortable_Part;
begin
Process_Statements_For_Controlled_Objects (Trig);
Process_Statements_For_Controlled_Objects (Abrt);
......@@ -6791,12 +6825,13 @@ package body Exp_Ch9 is
if Ada_Version >= Ada_2005
and then
(No (Original_Node (Ecall))
or else not Nkind_In (Original_Node (Ecall),
N_Delay_Relative_Statement,
N_Delay_Until_Statement))
or else not Nkind_In (Original_Node (Ecall),
N_Delay_Relative_Statement,
N_Delay_Until_Statement))
then
Extract_Dispatching_Call (Ecall, Call_Ent, Obj, Actuals, Formals);
Rewrite_Abortable_Part;
Decls := New_List;
Stmts := New_List;
......@@ -6831,9 +6866,9 @@ package body Exp_Ch9 is
Make_Object_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc, Name_uD),
Object_Definition =>
New_Reference_To (
RTE (RE_Dummy_Communication_Block), Loc)));
Object_Definition =>
New_Reference_To
(RTE (RE_Dummy_Communication_Block), Loc)));
K := Build_K (Loc, Decls, Obj);
......@@ -6875,8 +6910,7 @@ package body Exp_Ch9 is
Prepend_To (Cleanup_Stmts,
Make_Assignment_Statement (Loc,
Name =>
New_Reference_To (Bnn, Loc),
Name => New_Reference_To (Bnn, Loc),
Expression =>
Make_Unchecked_Type_Conversion (Loc,
Subtype_Mark =>
......@@ -6889,10 +6923,10 @@ package body Exp_Ch9 is
Prepend_To (Cleanup_Stmts,
Make_Procedure_Call_Statement (Loc,
Name =>
New_Reference_To (
Find_Prim_Op (Etype (Etype (Obj)),
Name_uDisp_Asynchronous_Select),
Loc),
New_Reference_To
(Find_Prim_Op
(Etype (Etype (Obj)), Name_uDisp_Asynchronous_Select),
Loc),
Parameter_Associations =>
New_List (
New_Copy_Tree (Obj), -- <object>
......@@ -7117,10 +7151,10 @@ package body Exp_Ch9 is
Append_To (Conc_Typ_Stmts,
Make_Procedure_Call_Statement (Loc,
Name =>
New_Reference_To (
Find_Prim_Op (Etype (Etype (Obj)),
Name_uDisp_Get_Prim_Op_Kind),
Loc),
New_Reference_To
(Find_Prim_Op (Etype (Etype (Obj)),
Name_uDisp_Get_Prim_Op_Kind),
Loc),
Parameter_Associations =>
New_List (
New_Copy_Tree (Obj),
......@@ -7240,11 +7274,11 @@ package body Exp_Ch9 is
Abortable_Block :=
Make_Block_Statement (Loc,
Identifier => New_Reference_To (Blk_Ent, Loc),
Identifier => New_Reference_To (Blk_Ent, Loc),
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => Astats),
Has_Created_Identifier => True,
Has_Created_Identifier => True,
Is_Asynchronous_Call_Block => True);
-- Append call to if Enqueue (When, DB'Unchecked_Access) then
......@@ -7292,8 +7326,8 @@ package body Exp_Ch9 is
Make_Object_Declaration (Loc,
Defining_Identifier => Dblock_Ent,
Aliased_Present => True,
Object_Definition => New_Reference_To (
RTE (RE_Delay_Block), Loc))),
Object_Definition =>
New_Reference_To (RTE (RE_Delay_Block), Loc))),
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc, Stmts)));
......@@ -7318,10 +7352,9 @@ package body Exp_Ch9 is
Decl := First (Decls);
while Present (Decl)
and then
(Nkind (Decl) /= N_Object_Declaration
or else not Is_RTE (Etype (Object_Definition (Decl)),
RE_Communication_Block))
and then (Nkind (Decl) /= N_Object_Declaration
or else not Is_RTE (Etype (Object_Definition (Decl)),
RE_Communication_Block))
loop
Next (Decl);
end loop;
......@@ -7338,13 +7371,12 @@ package body Exp_Ch9 is
-- Mode => Asynchronous_Call;
-- Block => Bnn);
Stmt := First (Stmts);
-- Skip assignments to temporaries created for in-out parameters
-- This makes unwarranted assumptions about the shape of the expanded
-- tree for the call, and should be cleaned up ???
Stmt := First (Stmts);
while Nkind (Stmt) /= N_Procedure_Call_Statement loop
Next (Stmt);
end loop;
......
......@@ -926,16 +926,21 @@ The following attributes can be defined in package @code{Naming}:
that contain declaration (header files in C for instance). The attribute
is indexed on the language.
The two attributes are equivalent, but the latter is obsolescent.
If the value of the attribute is the empty string, it indicates to the
Project Manager that the only specifications/header files for the language
are those specified with attributes @code{Spec} or
@code{Specification_Exceptions}.
If @code{Spec_Suffix ("Ada")} is not specified, then the default is
@code{"^.ads^.ADS^"}.
The value must satisfy the following requirements:
A non empty value must satisfy the following requirements:
@itemize -
@item It must not be empty
@item It cannot start with an alphanumeric character
@item It cannot start with an underscore followed by an alphanumeric character
@item It must include at least one dot
@item If @code{Dot_Replacement} is a single dot, then it cannot include
more than one dot.
@end itemize
@item @b{Body_Suffix} and @b{Implementation_Suffix}:
......@@ -945,6 +950,14 @@ The following attributes can be defined in package @code{Naming}:
code (bodies in Ada). They are indexed on the language. The second
version is obsolescent and fully replaced by the first attribute.
For each language of a project, one of these two attributes need to be
specified, either in the project itself or in the configuration project file.
If the value of the attribute is the empty string, it indicates to the
Project Manager that the only source files for the language
are those specified with attributes @code{Body} or
@code{Implementation_Exceptions}.
These attributes must satisfy the same requirements as @code{Spec_Suffix}.
In addition, they must be different from any of the values in
@code{Spec_Suffix}.
......@@ -956,10 +969,10 @@ The following attributes can be defined in package @code{Naming}:
suffixes will be a body if the longest suffix is @code{Body_Suffix ("Ada")}
or a spec if the longest suffix is @code{Spec_Suffix ("Ada")}.
If the suffix does not start with a '.', a file with a name exactly equal
to the suffix will also be part of the project (for instance if you define
the suffix as @code{Makefile}, a file called @file{Makefile} will be part
of the project. This capability is usually not interesting when building.
If the suffix does not start with a '.', a file with a name exactly equal to
the suffix will also be part of the project (for instance if you define the
suffix as @code{Makefile.in}, a file called @file{Makefile.in} will be part
of the project. This capability is usually not interesting when building.
However, it might become useful when a project is also used to
find the list of source files in an editor, like the GNAT Programming System
(GPS).
......@@ -968,7 +981,11 @@ The following attributes can be defined in package @code{Naming}:
@cindex @code{Separate_Suffix}
This attribute is specific to Ada. It denotes the suffix used in file names
that contain separate bodies. If it is not specified, then it defaults to
same value as @code{Body_Suffix ("Ada")}. The same rules apply as for the
same value as @code{Body_Suffix ("Ada")}.
The value of this attribute cannot be the empty string.
Otherwise, the same rules apply as for the
@code{Body_Suffix} attribute. The only accepted index is "Ada".
@item @b{Spec} or @b{Specification}:
......
......@@ -2789,11 +2789,11 @@ package body Sem_Ch6 is
and then
(Nkind (Original_Node (Spec_Decl)) =
N_Subprogram_Renaming_Declaration
or else (Present (Corresponding_Body (Spec_Decl))
and then
Nkind (Unit_Declaration_Node
(Corresponding_Body (Spec_Decl))) =
N_Subprogram_Renaming_Declaration))
or else (Present (Corresponding_Body (Spec_Decl))
and then
Nkind (Unit_Declaration_Node
(Corresponding_Body (Spec_Decl))) =
N_Subprogram_Renaming_Declaration))
then
Conformant := True;
......@@ -7663,13 +7663,16 @@ package body Sem_Ch6 is
end if;
-- Ada 2005 (AI-254): Anonymous access-to-subprogram types must be
-- treated recursively because they carry a signature.
-- treated recursively because they carry a signature. As far as
-- conformance is concerned, convention plays no role, and either
-- or both could be access to protected subprograms.
Are_Anonymous_Access_To_Subprogram_Types :=
Ekind (Type_1) = Ekind (Type_2)
Ekind_In (Type_1, E_Anonymous_Access_Subprogram_Type,
E_Anonymous_Access_Protected_Subprogram_Type)
and then
Ekind_In (Type_1, E_Anonymous_Access_Subprogram_Type,
E_Anonymous_Access_Protected_Subprogram_Type);
Ekind_In (Type_2, E_Anonymous_Access_Subprogram_Type,
E_Anonymous_Access_Protected_Subprogram_Type);
-- Test anonymous access type case. For this case, static subtype
-- matching is required for mode conformance (RM 6.3.1(15)). We check
......
......@@ -1576,6 +1576,22 @@ package body Sem_Res is
else
Resolve (N, Typ);
end if;
-- If in ASIS_Mode, propagate operand types to original actuals of
-- function call, which would otherwise not be fully resolved.
if ASIS_Mode then
if Is_Binary then
Set_Parameter_Associations
(Original_Node (N),
New_List (New_Copy_Tree (Left_Opnd (N)),
New_Copy_Tree (Right_Opnd (N))));
else
Set_Parameter_Associations
(Original_Node (N),
New_List (New_Copy_Tree (Right_Opnd (N))));
end if;
end if;
end Make_Call_Into_Operator;
-------------------
......
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