[multiple changes]

2014-07-31  Javier Miranda  <miranda@adacore.com>

	* gnat1drv.adb (Back_End_Inlining): Set to false if
	Suppress_All_Inlining is set.
	* debug.adb: Adding documentation for -gnatd.z.
	* inline.adb (Add_Inlined_Body): Extend the -gnatn2
	processing to -gnatn1 for calls to Inline_Always routines.
	(Add_Inlined_Subprogram): Remove previous patch.

2014-07-31  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Check_One_Function): Apply properly the static
	semantic rules for indexing aspects and the functions they denote.

From-SVN: r213361

5 files changed, 90 insertions, 29 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index f2a97c0..1c68482 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,19 @@
 2014-07-31  Javier Miranda  <miranda@adacore.com>
 
+	* gnat1drv.adb (Back_End_Inlining): Set to false if
+	Suppress_All_Inlining is set.
+	* debug.adb: Adding documentation for -gnatd.z.
+	* inline.adb (Add_Inlined_Body): Extend the -gnatn2
+	processing to -gnatn1 for calls to Inline_Always routines.
+	(Add_Inlined_Subprogram): Remove previous patch.
+
+2014-07-31  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch13.adb (Check_One_Function): Apply properly the static
+	semantic rules for indexing aspects and the functions they denote.
+
+2014-07-31  Javier Miranda  <miranda@adacore.com>
+
 	* debug.adb: Complete documentation of -gnatd.z.
 
 2014-07-31  Bob Duff  <duff@adacore.com>
diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index 562a49c..02f8d1f 100644
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -598,8 +598,12 @@ package body Debug is
    --       all targets except AAMP, .NET and JVM). This switch has no effect
    --       under GNATprove to avoid confusing the formal verification output,
    --       and it has no effect if the sources are compiled with frontend
-   --       inlining (ie. -gnatN). This switch is currently used to evaluate
-   --       the impact of back end inlining.
+   --       inlining (ie. -gnatN). This switch is used to evaluate the impact
+   --       of back end inlining since the GCC backend has now more support for
+   --       inlining than before, and hence most of the inlinings that are
+   --       currently handled by the frontend can be done by the backend with
+   --       the extra benefit of supporting cases which are currently rejected
+   --       by GNAT.
 
    --  d.A  There seems to be a problem with ASIS if we activate the circuit
    --       for reading and writing the aspect specification hash table, so
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index 46c046c..960f75d 100644
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -598,9 +598,13 @@ procedure Gnat1drv is
 
       Back_End_Inlining :=
 
+        --  No back end inlining if inlining is suppressed
+
+        not Suppress_All_Inlining
+
         --  No back end inlining available for VM targets
 
-        VM_Target = No_VM
+        and then VM_Target = No_VM
 
         --  No back end inlining available on AAMP
 
diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index 758a0702..c8fdc32 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -377,10 +377,14 @@ package body Inline is
                   Inlined_Bodies.Increment_Last;
                   Inlined_Bodies.Table (Inlined_Bodies.Last) := Pack;
 
-               --  If the backend takes care of inlining the call then we must
-               --  ensure that it has available the body of the subprogram.
+               --  Extend the -gnatn2 processing to -gnatn1 for Inline_Always
+               --  calls if the back-end takes care of inlining the call.
 
-               elsif Level = Inline_Call and then Back_End_Inlining then
+               elsif Level = Inline_Call
+                 and then Has_Pragma_Inline_Always (E)
+                 and then Back_End_Inlining
+               then
+                  Set_Is_Inlined (Pack);
                   Inlined_Bodies.Increment_Last;
                   Inlined_Bodies.Table (Inlined_Bodies.Last) := Pack;
                end if;
@@ -465,16 +469,11 @@ package body Inline is
       --  subprogram has been generated by the compiler, and if it is declared
       --  at the library level not in the main unit, and if it can be inlined
       --  by the back-end, then insert it in the list of inlined subprograms.
-      --  We also add it when its unit is not inlined but we are compiling with
-      --  Back_End_Inlining since at this stage we know that Add_Inlined_Body
-      --  forced loading its unit to allow the backend to inline single calls
-      --  at -gnatn1
 
       if Is_Inlined (E)
         and then (Is_Inlined (Pack)
                    or else Is_Generic_Instance (Pack)
-                   or else Is_Internal (E)
-                   or else Back_End_Inlining)
+                   or else Is_Internal (E))
         and then not In_Main_Unit_Or_Subunit (E)
         and then not Is_Nested (E)
         and then not Has_Initialized_Type (E)
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index e58614d..4610fe0 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -3470,8 +3470,8 @@ package body Sem_Ch13 is
          Indexing_Found : Boolean;
 
          procedure Check_One_Function (Subp : Entity_Id);
-         --  Check one possible interpretation. Sets Indexing_Found True if an
-         --  indexing function is found.
+         --  Check one possible interpretation. Sets Indexing_Found True if a
+         --  legal indexing function is found.
 
          procedure Illegal_Indexing (Msg : String);
          --  Diagnose illegal indexing function if not overloaded. In the
@@ -3490,9 +3490,15 @@ package body Sem_Ch13 is
                Illegal_Indexing ("illegal indexing function for type&");
                return;
 
-            elsif Scope (Subp) /= Current_Scope then
-               Illegal_Indexing
-                 ("indexing function must be declared in scope of type&");
+            elsif Scope (Subp) /= Scope (Ent) then
+               if Nkind (Expr) = N_Expanded_Name then
+
+                  --  Indexing function can't be declared elsewhere
+
+                  Illegal_Indexing
+                    ("indexing function must be declared in scope of type&");
+               end if;
+
                return;
 
             elsif No (First_Formal (Subp)) then
@@ -3521,20 +3527,54 @@ package body Sem_Ch13 is
                      Illegal_Indexing
                         ("indexing function already inherited "
                           & "from parent type");
+                     return;
                   end if;
-
-                  return;
                end if;
             end if;
 
             if not Check_Primitive_Function (Subp)
-              and then not Is_Overloaded (Expr)
             then
                Illegal_Indexing
                  ("Indexing aspect requires a function that applies to type&");
                return;
             end if;
 
+            --  If partial declaration exists, verify that it is not tagged.
+
+            if Ekind (Current_Scope) = E_Package
+              and then Has_Private_Declaration (Ent)
+              and then From_Aspect_Specification (N)
+              and then List_Containing (Parent (Ent))
+                 = Private_Declarations
+                    (Specification (Unit_Declaration_Node (Current_Scope)))
+              and then Nkind (N) = N_Attribute_Definition_Clause
+            then
+               declare
+                  Decl : Node_Id;
+
+               begin
+                  Decl :=
+                     First (Visible_Declarations
+                      (Specification
+                        (Unit_Declaration_Node (Current_Scope))));
+
+                  while Present (Decl) loop
+                     if Nkind (Decl) = N_Private_Type_Declaration
+                       and then Ent = Full_View (Defining_Identifier (Decl))
+                       and then Tagged_Present (Decl)
+                       and then No (Aspect_Specifications (Decl))
+                     then
+                        Illegal_Indexing
+                          ("Indexing aspect cannot be specified on full view "
+                             & "if partial view is tagged");
+                        return;
+                     end if;
+
+                     Next (Decl);
+                  end loop;
+               end;
+            end if;
+
             --  An indexing function must return either the default element of
             --  the container, or a reference type. For variable indexing it
             --  must be the latter.
@@ -3600,9 +3640,7 @@ package body Sem_Ch13 is
 
          procedure Illegal_Indexing (Msg : String) is
          begin
-            if not Is_Overloaded (Expr) then
-               Error_Msg_NE (Msg, N, Ent);
-            end if;
+            Error_Msg_NE (Msg, N, Ent);
          end Illegal_Indexing;
 
       --  Start of processing for Check_Indexing_Functions
@@ -3637,14 +3675,16 @@ package body Sem_Ch13 is
 
                   Get_Next_Interp (I, It);
                end loop;
-
-               if not Indexing_Found then
-                  Error_Msg_NE
-                    ("aspect Indexing requires a function that "
-                     & "applies to type&", Expr, Ent);
-               end if;
             end;
          end if;
+
+         if not Indexing_Found
+           and then not Error_Posted (N)
+         then
+            Error_Msg_NE
+              ("aspect Indexing requires a local function that "
+               & "applies to type&", Expr, Ent);
+         end if;
       end Check_Indexing_Functions;
 
       ------------------------------