[multiple changes]

2014-07-31  Robert Dewar  <dewar@adacore.com>

	* par-ch13.adb (Get_Aspect_Specifications): Set Inside_Depends.
	* par-ch2.adb (P_Pragma): Set Inside_Depends.
	* par-ch4.adb (P_Simple_Expression): Pass Inside_Depends to
	Check_Unary_Plus_Or_Minus.
	* scans.ads (Inside_Depends): New flag.
	* scng.adb (Scan): Pass Inside_Depends to Check_Arrow.
	* style.ads: Add Inside_Depends parameter to Check_Arrow Add
	Inside_Depends parameter to Check_Unary_Plus_Or_Minus.
	* styleg.adb (Check_Arrow): Handle Inside_Depends case.
	(Check_Unary_Plus_Or_Minus): Handle Inside_Depends case.
	* styleg.ads: Add Inside_Depends parameter to Check_Arrow Add.
	Inside_Depends parameter to Check_Unary_Plus_Or_Minus.

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

	* s-vaflop.adb Move the body of function T_To_G before
	T_To_D. Required for frontend inlining.
	* inline.adb (Has_Excluded_Contract): New subprogram used to
	check if a subprogram inlined by the frontend has contracts
	which cannot be inlined.

2014-07-31  Bob Duff  <duff@adacore.com>

	* s-traceb.adb, s-traceb-hpux.adb, s-traceb-mastop.adb:
	(Call_Chain): Add 1 to number of frames to skip, to account for
	the fact that there's one more frame on the stack.

From-SVN: r213336

gcc/ada/ChangeLog

@@ -1,3 +1,32 @@
+2014-07-31  Robert Dewar  <dewar@adacore.com>
+
+	* par-ch13.adb (Get_Aspect_Specifications): Set Inside_Depends.
+	* par-ch2.adb (P_Pragma): Set Inside_Depends.
+	* par-ch4.adb (P_Simple_Expression): Pass Inside_Depends to
+	Check_Unary_Plus_Or_Minus.
+	* scans.ads (Inside_Depends): New flag.
+	* scng.adb (Scan): Pass Inside_Depends to Check_Arrow.
+	* style.ads: Add Inside_Depends parameter to Check_Arrow Add
+	Inside_Depends parameter to Check_Unary_Plus_Or_Minus.
+	* styleg.adb (Check_Arrow): Handle Inside_Depends case.
+	(Check_Unary_Plus_Or_Minus): Handle Inside_Depends case.
+	* styleg.ads: Add Inside_Depends parameter to Check_Arrow Add.
+	Inside_Depends parameter to Check_Unary_Plus_Or_Minus.
+
+2014-07-31  Javier Miranda  <miranda@adacore.com>
+
+	* s-vaflop.adb Move the body of function T_To_G before
+	T_To_D. Required for frontend inlining.
+	* inline.adb (Has_Excluded_Contract): New subprogram used to
+	check if a subprogram inlined by the frontend has contracts
+	which cannot be inlined.
+
+2014-07-31  Bob Duff  <duff@adacore.com>
+
+	* s-traceb.adb, s-traceb-hpux.adb, s-traceb-mastop.adb:
+	(Call_Chain): Add 1 to number of frames to skip, to account for
+	the fact that there's one more frame on the stack.
+
 2014-07-31  Robert Dewar  <dewar@adacore.com>
 
 	* checks.adb (Enable_Overflow_Check): More precise setting of

gcc/ada/inline.adb

@@ -1828,6 +1828,10 @@ package body Inline is
       --    - functions that have exception handlers
       --    - functions that have some enclosing body containing instantiations
       --      that appear before the corresponding generic body.
+      --    - functions that have some of the following contracts (and the
+      --      sources are compiled with assertions enabled):
+      --         - Pre/post condition
+      --         - Contract cases
 
       procedure Generate_Body_To_Inline
         (N              : Node_Id;
@@ -1926,6 +1930,9 @@ package body Inline is
          Max_Size   : constant := 10;
          Stat_Count : Integer := 0;
 
+         function Has_Excluded_Contract return Boolean;
+         --  Check for contracts that cannot be inlined
+
          function Has_Excluded_Declaration (Decls : List_Id) return Boolean;
          --  Check for declarations that make inlining not worthwhile
 
@@ -1956,6 +1963,70 @@ package body Inline is
          --  unconstrained type, the secondary stack is involved, and it
          --  is not worth inlining.
 
+         ---------------------------
+         -- Has_Excluded_Contract --
+         ---------------------------
+
+         function Has_Excluded_Contract return Boolean is
+
+            function Check_Excluded_Contracts (E : Entity_Id) return Boolean;
+            --  Return True if the subprogram E has unsupported contracts
+
+            function Check_Excluded_Contracts (E : Entity_Id) return Boolean is
+               Items : constant Node_Id := Contract (E);
+
+            begin
+               if Present (Items) then
+                  if Present (Pre_Post_Conditions (Items))
+                    or else Present (Contract_Test_Cases (Items))
+                  then
+                     Cannot_Inline
+                       ("cannot inline & (non-allowed contract)?",
+                        N, Subp);
+                     return True;
+                  end if;
+               end if;
+
+               return False;
+            end Check_Excluded_Contracts;
+
+            Decl : Node_Id;
+            P_Id : Pragma_Id;
+         begin
+            if Check_Excluded_Contracts (Spec_Id)
+              or else Check_Excluded_Contracts (Body_Id)
+            then
+               return True;
+            end if;
+
+            --  Check pragmas located in the body which may generate contracts
+
+            if Present (Declarations (N)) then
+               Decl := First (Declarations (N));
+               while Present (Decl) loop
+                  if Nkind (Decl) = N_Pragma then
+                     P_Id := Get_Pragma_Id (Pragma_Name (Decl));
+
+                     if P_Id = Pragma_Contract_Cases or else
+                        P_Id = Pragma_Pre            or else
+                        P_Id = Pragma_Precondition   or else
+                        P_Id = Pragma_Post           or else
+                        P_Id = Pragma_Postcondition
+                     then
+                        Cannot_Inline
+                          ("cannot inline & (non-allowed contract)?",
+                           N, Subp);
+                        return True;
+                     end if;
+                  end if;
+
+                  Next (Decl);
+               end loop;
+            end if;
+
+            return False;
+         end Has_Excluded_Contract;
+
          ------------------------------
          -- Has_Excluded_Declaration --
          ------------------------------
@@ -2443,6 +2514,16 @@ package body Inline is
          elsif Present (Body_To_Inline (Decl)) then
             return False;
 
+         --  Cannot build the body to inline if the subprogram has unsupported
+         --  contracts that will be expanded into code (if assertions are not
+         --  enabled these pragmas will be removed by Generate_Body_To_Inline
+         --  to avoid reporting spurious errors).
+
+         elsif Assertions_Enabled
+           and then Has_Excluded_Contract
+         then
+            return False;
+
          --  Subprograms that have return statements in the middle of the
          --  body are inlined with gotos. GNATprove does not currently
          --  support gotos, so we prevent such inlining.
@@ -2660,7 +2741,10 @@ package body Inline is
                Nxt := Next (Decl);
 
                if Nkind (Decl) = N_Pragma
-                 and then Nam_In (Pragma_Name (Decl), Name_Unreferenced,
+                 and then Nam_In (Pragma_Name (Decl), Name_Contract_Cases,
+                                                      Name_Precondition,
+                                                      Name_Postcondition,
+                                                      Name_Unreferenced,
                                                       Name_Unmodified)
                then
                   Remove (Decl);

gcc/ada/par-ch13.adb

@@ -170,6 +170,8 @@ package body Ch13 is
       Scan; -- past WITH
       Aspects := Empty_List;
 
+      --  Loop to scan aspects
+
       loop
          OK := True;
 
@@ -445,6 +447,12 @@ package body Ch13 is
                   end if;
                end if;
 
+               --  Note if inside Depends aspect
+
+               if A_Id = Aspect_Depends then
+                  Inside_Depends := True;
+               end if;
+
                --  Parse the aspect definition depening on the expected
                --  argument kind.
 
@@ -460,6 +468,10 @@ package body Ch13 is
                      Aspect_Argument (A_Id) = Optional_Expression);
                   Set_Expression (Aspect, P_Expression);
                end if;
+
+               --  Unconditionally reset flag for Inside_Depends
+
+               Inside_Depends := False;
             end if;
 
             --  Add the aspect to the resulting list only when it was properly

gcc/ada/par-ch2.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -298,13 +298,19 @@ package body Ch2 is
          Import_Check_Required    := False;
       end if;
 
+      --  Set global to indicate if we are within a Depends pragma
+
+      if Chars (Ident_Node) = Name_Depends then
+         Inside_Depends := True;
+      end if;
+
       --  Scan arguments. We assume that arguments are present if there is
       --  a left paren, or if a semicolon is missing and there is another
       --  token on the same line as the pragma name.
 
       if Token = Tok_Left_Paren
         or else (Token /= Tok_Semicolon
-                   and then not Token_Is_At_Start_Of_Line)
+                  and then not Token_Is_At_Start_Of_Line)
       then
          Set_Pragma_Argument_Associations (Prag_Node, New_List);
          T_Left_Paren;
@@ -349,6 +355,11 @@ package body Ch2 is
 
       Semicolon_Loc := Token_Ptr;
 
+      --  Cancel indication of being within Depends pragm. Can be done
+      --  unconditionally, since quicker than doing a test.
+
+      Inside_Depends := False;
+
       --  Now we have two tasks left, we need to scan out the semicolon
       --  following the pragma, and we have to call Par.Prag to process
       --  the pragma. Normally we do them in this order, however, there

gcc/ada/par-ch4.adb

@@ -2106,7 +2106,7 @@ package body Ch4 is
             Node1 := New_Op_Node (P_Unary_Adding_Operator, Tokptr);
 
             if Style_Check then
-               Style.Check_Unary_Plus_Or_Minus;
+               Style.Check_Unary_Plus_Or_Minus (Inside_Depends);
             end if;
 
             Scan; -- past operator

gcc/ada/s-traceb-hpux.adb

@@ -262,14 +262,15 @@ package body System.Traceback is
    --  but it is not usable when frames with dynamically allocated space are
    --  on the way.
 
-   procedure Call_Chain
-     (Traceback   : System.Address;
-      Max_Len     : Natural;
-      Len         : out Natural;
-      Exclude_Min : System.Address := System.Null_Address;
-      Exclude_Max : System.Address := System.Null_Address;
-      Skip_Frames : Natural := 1);
-   --  Same as the exported version, but takes Traceback as an Address
+--   procedure Call_Chain
+--     (Traceback   : System.Address;
+--      Max_Len     : Natural;
+--      Len         : out Natural;
+--      Exclude_Min : System.Address := System.Null_Address;
+--      Exclude_Max : System.Address := System.Null_Address;
+--      Skip_Frames : Natural := 1);
+--   --  Same as the exported version, but takes Traceback as an Address
+--  ???See declaration in the spec for why this is temporarily commented out.
 
    ------------------
    -- C_Call_Chain --
@@ -280,7 +281,6 @@ package body System.Traceback is
       Max_Len   : Natural) return Natural
    is
       Val : Natural;
-
    begin
       Call_Chain (Traceback, Max_Len, Val);
       return Val;
@@ -618,7 +618,8 @@ package body System.Traceback is
    begin
       Call_Chain
         (Traceback'Address, Max_Len, Len,
-         Exclude_Min, Exclude_Max, Skip_Frames);
+         Exclude_Min, Exclude_Max, Skip_Frames + 1);
+      --  Skip one extra frame so we skip the other Call_Chain as well
    end Call_Chain;
 
 end System.Traceback;

gcc/ada/s-traceb-mastop.adb

@@ -37,14 +37,15 @@ package body System.Traceback is
 
    use System.Machine_State_Operations;
 
-   procedure Call_Chain
-     (Traceback   : System.Address;
-      Max_Len     : Natural;
-      Len         : out Natural;
-      Exclude_Min : System.Address := System.Null_Address;
-      Exclude_Max : System.Address := System.Null_Address;
-      Skip_Frames : Natural := 1);
-   --  Same as the exported version, but takes Traceback as an Address
+--   procedure Call_Chain
+--     (Traceback   : System.Address;
+--      Max_Len     : Natural;
+--      Len         : out Natural;
+--      Exclude_Min : System.Address := System.Null_Address;
+--      Exclude_Max : System.Address := System.Null_Address;
+--      Skip_Frames : Natural := 1);
+--   --  Same as the exported version, but takes Traceback as an Address
+--  ???See declaration in the spec for why this is temporarily commented out.
 
    ----------------
    -- Call_Chain --
@@ -113,7 +114,8 @@ package body System.Traceback is
    begin
       Call_Chain
         (Traceback'Address, Max_Len, Len,
-         Exclude_Min, Exclude_Max, Skip_Frames);
+         Exclude_Min, Exclude_Max, Skip_Frames + 1);
+      --  Skip one extra frame so we skip the other Call_Chain as well
    end Call_Chain;
 
    ------------------

gcc/ada/s-traceb.adb

@@ -38,14 +38,15 @@ pragma Compiler_Unit_Warning;
 
 package body System.Traceback is
 
-   procedure Call_Chain
-     (Traceback   : System.Address;
-      Max_Len     : Natural;
-      Len         : out Natural;
-      Exclude_Min : System.Address := System.Null_Address;
-      Exclude_Max : System.Address := System.Null_Address;
-      Skip_Frames : Natural := 1);
-   --  Same as the exported version, but takes Traceback as an Address
+--   procedure Call_Chain
+--     (Traceback   : System.Address;
+--      Max_Len     : Natural;
+--      Len         : out Natural;
+--      Exclude_Min : System.Address := System.Null_Address;
+--      Exclude_Max : System.Address := System.Null_Address;
+--      Skip_Frames : Natural := 1);
+--   --  Same as the exported version, but takes Traceback as an Address
+--  ???See declaration in the spec for why this is temporarily commented out.
 
    ------------------
    -- C_Call_Chain --
@@ -53,11 +54,9 @@ package body System.Traceback is
 
    function C_Call_Chain
      (Traceback : System.Address;
-      Max_Len   : Natural)
-      return      Natural
+      Max_Len   : Natural) return Natural
    is
       Val : Natural;
-
    begin
       Call_Chain (Traceback, Max_Len, Val);
       return Val;
@@ -110,7 +109,8 @@ package body System.Traceback is
    begin
       Call_Chain
         (Traceback'Address, Max_Len, Len,
-         Exclude_Min, Exclude_Max, Skip_Frames);
+         Exclude_Min, Exclude_Max, Skip_Frames + 1);
+      --  Skip one extra frame so we skip the other Call_Chain as well
    end Call_Chain;
 
 end System.Traceback;

gcc/ada/s-vaflop.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1997-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1997-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -443,6 +443,17 @@ package body System.Vax_Float_Operations is
       return X - Y;
    end Sub_G;
 
+   ------------
+   -- T_To_G --
+   ------------
+
+   --  This function must be located before T_To_D for frontend inlining
+
+   function T_To_G (X : T) return G is
+   begin
+      return G (X);
+   end T_To_G;
+
    ------------
    -- T_To_D --
    ------------
@@ -452,15 +463,6 @@ package body System.Vax_Float_Operations is
       return G_To_D (T_To_G (X));
    end T_To_D;
 
-   ------------
-   -- T_To_G --
-   ------------
-
-   function T_To_G (X : T) return G is
-   begin
-      return G (X);
-   end T_To_G;
-
    -------------
    -- Valid_D --
    -------------

gcc/ada/scans.ads

@@ -472,6 +472,10 @@ package Scans is
    --  Is it really right for this to be a Name rather than a String, what
    --  about the case of Wide_Wide_Characters???
 
+   Inside_Depends : Boolean := False;
+   --  Flag set True for parsing the argument of a Depends pragma or aspect
+   --  (used to allow/require non-standard style rules for =>+ with -gnatyt).
+
    Inside_If_Expression : Nat := 0;
    --  This is a counter that is set non-zero while scanning out an if
    --  expression (incremented on entry, decremented on exit). It is used to

gcc/ada/scng.adb

@@ -1571,7 +1571,7 @@ package body Scng is
                Token := Tok_Arrow;
 
                if Style_Check then
-                  Style.Check_Arrow;
+                  Style.Check_Arrow (Inside_Depends);
                end if;
 
                return;

gcc/ada/style.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -79,7 +79,7 @@ package Style is
      renames Style_Inst.Check_Apostrophe;
    --  Called after scanning an apostrophe to check spacing
 
-   procedure Check_Arrow
+   procedure Check_Arrow (Inside_Depends : Boolean := False)
      renames Style_Inst.Check_Arrow;
    --  Called after scanning out an arrow to check spacing
 
@@ -180,7 +180,7 @@ package Style is
    --  procedure is called only if THEN appears at the start of a line with
    --  Token_Ptr pointing to the THEN keyword.
 
-   procedure Check_Unary_Plus_Or_Minus
+   procedure Check_Unary_Plus_Or_Minus (Inside_Depends : Boolean := False)
      renames Style_Inst.Check_Unary_Plus_Or_Minus;
    --  Called after scanning a unary plus or minus to check spacing
 

gcc/ada/styleg.adb

@@ -126,13 +126,32 @@ package body Styleg is
    -- Check_Arrow --
    -----------------
 
-   --  In check tokens mode (-gnatys), arrow must be surrounded by spaces
+   --  In check tokens mode (-gnatys), arrow must be surrounded by spaces,
+   --  except that within the argument of a Depends macro the required format
+   --  is =>+ rather than => +).
 
-   procedure Check_Arrow is
+   procedure Check_Arrow (Inside_Depends : Boolean := False) is
    begin
       if Style_Check_Tokens then
          Require_Preceding_Space;
-         Require_Following_Space;
+
+         if not Inside_Depends then
+            Require_Following_Space;
+
+         --  Special handling for Inside_Depends
+
+         else
+            if Source (Scan_Ptr) = ' '
+              and then Source (Scan_Ptr + 1) = '+'
+            then
+               Error_Space_Not_Allowed (Scan_Ptr);
+
+            elsif Source (Scan_Ptr) /= ' '
+              and then Source (Scan_Ptr) /= '+'
+            then
+               Require_Following_Space;
+            end if;
+         end if;
       end if;
    end Check_Arrow;
 
@@ -1032,10 +1051,17 @@ package body Styleg is
    --  In check token mode (-gnatyt), unary plus or minus must not be
    --  followed by a space.
 
-   procedure Check_Unary_Plus_Or_Minus is
+   --  Annoying exception: if we have the sequence =>+ within a Depends pragma
+   --  or aspect, then we insist on a space rather than forbidding it.
+
+   procedure Check_Unary_Plus_Or_Minus (Inside_Depends : Boolean := False) is
    begin
       if Style_Check_Tokens then
-         Check_No_Space_After;
+         if not Inside_Depends then
+            Check_No_Space_After;
+         else
+            Require_Following_Space;
+         end if;
       end if;
    end Check_Unary_Plus_Or_Minus;
 

gcc/ada/styleg.ads

@@ -2,11 +2,11 @@
 --                                                                          --
 --                         GNAT COMPILER COMPONENTS                         --
 --                                                                          --
---                              S T Y L E G                                 --
+--                               S T Y L E G                                --
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -52,8 +52,10 @@ package Styleg is
    procedure Check_Apostrophe;
    --  Called after scanning an apostrophe to check spacing
 
-   procedure Check_Arrow;
-   --  Called after scanning out an arrow to check spacing
+   procedure Check_Arrow (Inside_Depends : Boolean := False);
+   --  Called after scanning out an arrow to check spacing. Inside_Depends is
+   --  true if the call is from an argument of the Depends pragma (where the
+   --  allowed/required format is =>+).
 
    procedure Check_Attribute_Name (Reserved : Boolean);
    --  The current token is an attribute designator. Check that it
@@ -143,8 +145,10 @@ package Styleg is
    --  would interfere with coverage testing). Handles case of THEN ABORT as
    --  an exception, as well as PRAGMA after ELSE.
 
-   procedure Check_Unary_Plus_Or_Minus;
-   --  Called after scanning a unary plus or minus to check spacing
+   procedure Check_Unary_Plus_Or_Minus  (Inside_Depends : Boolean := False);
+   --  Called after scanning a unary plus or minus to check spacing. The flag
+   --  Inside_Depends is set if we are scanning within a Depends pragma or
+   --  Aspect, in which case =>+ requires a following space).
 
    procedure Check_Vertical_Bar;
    --  Called after scanning a vertical bar to check spacing