[multiple changes]

2013-01-02  Thomas Quinot  <quinot@adacore.com>

	* par_sco.adb: Generate X SCOs for default expressions in
	subprogram body stubs.	Do not generate any SCO for package,
	task, or protected body stubs.

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

	* sem_ch3.adb: Further improvement to ASIS mode for anonymous
	access to protected subprograms.

From-SVN: r194796

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d2c090dc4eba3fad8f0b3a5e1ec49964c149ec60..6753ce4a1d5f5580387f2ff943eddd760d38344e 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,14 @@
+2013-01-02  Thomas Quinot  <quinot@adacore.com>
+
+       * par_sco.adb: Generate X SCOs for default expressions in
+       subprogram body stubs.  Do not generate any SCO for package,
+       task, or protected body stubs.
+
+2013-01-02  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch3.adb: Further improvement to ASIS mode for anonymous
+       access to protected subprograms.
+
 2013-01-02  Robert Dewar  <dewar@adacore.com>
 
        * par_sco.adb, vms_data.ads: Minor reformatting.

diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb
index 059103f616aebd335a14447ae7738610a9b5df55..e46f2422c48f8fbc4f7c77324499eec181ffdc46 100644 (file)
--- a/gcc/ada/par_sco.adb
+++ b/gcc/ada/par_sco.adb
@@ -1048,10 +1048,15 @@ package body Par_SCO is
 
       Index := Condition_Pragma_Hash_Table.Get (Loc);
 
-      --  The test here for zero is to deal with possible previous errors
+      --  A zero index here indicates that semantic analysis found an
+      --  activated pragma at Loc which does not have a corresponding pragma
+      --  or aspect at the syntax level. This may occur in legitimate cases
+      --  because of expanded code (such are Pre/Post conditions generated for
+      --  formal parameter validity checks), or as a consequence of a previous
+      --  error.
 
       if Index = 0 then
-         Check_Error_Detected;
+         return;
 
       else
          declare
@@ -1533,7 +1538,7 @@ package body Par_SCO is
 
             --  Subprogram declaration
 
-            when N_Subprogram_Declaration =>
+            when N_Subprogram_Declaration | N_Subprogram_Body_Stub =>
                Process_Decisions_Defer
                  (Parameter_Specifications (Specification (N)), 'X');
 
@@ -2041,7 +2046,10 @@ package body Par_SCO is
 
                      when N_Representation_Clause         |
                           N_Use_Package_Clause            |
-                          N_Use_Type_Clause               =>
+                          N_Use_Type_Clause               |
+                          N_Package_Body_Stub             |
+                          N_Task_Body_Stub                |
+                          N_Protected_Body_Stub           =>
                         Typ := ASCII.NUL;
 
                      when others                          =>

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index eb25443babf4d5bfd93df943d6b2c6670d5fe664..5b67e26aa8475a7b2e704b257399bd068f1a3762 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -5049,10 +5049,45 @@ package body Sem_Ch3 is
       Decl :=
         Make_Full_Type_Declaration (Loc,
           Defining_Identifier => Anon,
-          Type_Definition     => Relocate_Node (Spec));
+          Type_Definition     => Copy_Separate_Tree (Spec));
 
       Mark_Rewrite_Insertion (Decl);
 
+      --  In ASIS mode, analyze the profile on the original node, because
+      --  the separate copy does not provide enough links to recover the
+      --  original tree. Analysis is limited to type annotations, within
+      --  a temporary scope that serves as an anonnymous subprogram to
+      --  collect otherwise useless temporaries and itypes.
+
+      if ASIS_Mode then
+         declare
+            Typ : constant Entity_Id :=  Make_Temporary (Loc, 'S');
+
+         begin
+            if Nkind (Spec) = N_Access_Function_Definition then
+               Set_Ekind (Typ, E_Function);
+            else
+               Set_Ekind (Typ, E_Procedure);
+            end if;
+
+            Set_Parent (Typ, N);
+            Set_Scope  (Typ, Current_Scope);
+            Push_Scope (Typ);
+
+            Process_Formals (Parameter_Specifications (Spec), Spec);
+
+            if Nkind (Spec) = N_Access_Function_Definition then
+               if Nkind (Result_Definition (Spec)) = N_Access_Definition then
+                  Find_Type (Subtype_Mark (Result_Definition (Spec)));
+               else
+                  Find_Type (Result_Definition (Spec));
+               end if;
+            end if;
+
+            End_Scope;
+         end;
+      end if;
+
       --  Insert the new declaration in the nearest enclosing scope. If the
       --  node is a body and N is its return type, the declaration belongs in
       --  the enclosing scope.