+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).
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);
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;
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);
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 =>
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>
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),
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
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)));
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;
-- 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;
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}:
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}.
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).
@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}:
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;
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
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;
-------------------
projects / thirdparty / gcc.git / commitdiff
