[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

5 files changed, 138 insertions, 45 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index f11eaa6..a463f6a 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,30 @@
 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.
 
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 59c5b2d..fdafd22 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -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;
diff --git a/gcc/ada/projects.texi b/gcc/ada/projects.texi
index 2c33468..7072e0e 100644
--- a/gcc/ada/projects.texi
+++ b/gcc/ada/projects.texi
@@ -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}:
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 68edadf..57712d8 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -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
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 95cc437..9b26f09 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -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;
 
    -------------------