exp_ch6.adb (Expand_N_Extended_Return_Statement): Do not call SS_Release for a block statement enclosing the return statement in...

2015-10-23  Bob Duff  <duff@adacore.com>

	* exp_ch6.adb (Expand_N_Extended_Return_Statement): Do not call
	SS_Release for a block statement enclosing the return statement in the
	case where a build-in-place function return is returning
	the result on the secondary stack. This is accomplished by
	setting the Sec_Stack_Needed_For_Return flag on such blocks.
	It was already being set for the function itself, and it was
	already set correctly for blocks in the non-build-in-place case
	(in Expand_Simple_Function_Return).
	(Set_Enclosing_Sec_Stack_Return): New procedure to perform
	the Set_Sec_Stack_Needed_For_Return calls. Called in the
	build-in-place and non-build-in-place cases.
	(Expand_Simple_Function_Return): Call
	Set_Enclosing_Sec_Stack_Return instead of performing the loop
	in line.

2015-10-23  Bob Duff  <duff@adacore.com>

	* scng.adb (Char_Literal_Case): If an apostrophe
	follows a reserved word, treat it as a lone apostrophe, rather
	than the start of a character literal. This was already done for
	"all", but it needs to be done also for (e.g.) "Delta".

From-SVN: r229226

3 files changed, 95 insertions, 53 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a8f16d8..02301d5 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,29 @@
 2015-10-23  Bob Duff  <duff@adacore.com>
 
+	* exp_ch6.adb (Expand_N_Extended_Return_Statement): Do not call
+	SS_Release for a block statement enclosing the return statement in the
+	case where a build-in-place function return is returning
+	the result on the secondary stack. This is accomplished by
+	setting the Sec_Stack_Needed_For_Return flag on such blocks.
+	It was already being set for the function itself, and it was
+	already set correctly for blocks in the non-build-in-place case
+	(in Expand_Simple_Function_Return).
+	(Set_Enclosing_Sec_Stack_Return): New procedure to perform
+	the Set_Sec_Stack_Needed_For_Return calls. Called in the
+	build-in-place and non-build-in-place cases.
+	(Expand_Simple_Function_Return): Call
+	Set_Enclosing_Sec_Stack_Return instead of performing the loop
+	in line.
+
+2015-10-23  Bob Duff  <duff@adacore.com>
+
+	* scng.adb (Char_Literal_Case): If an apostrophe
+	follows a reserved word, treat it as a lone apostrophe, rather
+	than the start of a character literal. This was already done for
+	"all", but it needs to be done also for (e.g.) "Delta".
+
+2015-10-23  Bob Duff  <duff@adacore.com>
+
 	* exp_strm.adb (Build_Record_Or_Elementary_Input_Function): Use
 	Underlying_Type for B_Typ, in case the Typ is a subtype of a type with
 	unknown discriminants.
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 2688e2e..31267a5 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -258,6 +258,13 @@ package body Exp_Ch6 is
    --  Expand simple return from function. In the case where we are returning
    --  from a function body this is called by Expand_N_Simple_Return_Statement.
 
+   procedure Set_Enclosing_Sec_Stack_Return (N : Node_Id);
+   --  N is a return statement for a function that returns its result on the
+   --  secondary stack. This sets the Sec_Stack_Needed_For_Return flag on the
+   --  function and all blocks and loops that the return statement is jumping
+   --  out of. This ensures that the secondary stack is not released; otherwise
+   --  the function result would be reclaimed before returning to the caller.
+
    ----------------------------------------------
    -- Add_Access_Actual_To_Build_In_Place_Call --
    ----------------------------------------------
@@ -4662,18 +4669,18 @@ package body Exp_Ch6 is
 
                      --  The allocator is returned on the secondary stack,
                      --  so indicate that the function return, as well as
-                     --  the block that encloses the allocator, must not
+                     --  all blocks that encloses the allocator, must not
                      --  release it. The flags must be set now because
                      --  the decision to use the secondary stack is done
                      --  very late in the course of expanding the return
                      --  statement, past the point where these flags are
                      --  normally set.
 
-                     Set_Sec_Stack_Needed_For_Return (Func_Id);
-                     Set_Sec_Stack_Needed_For_Return
-                       (Return_Statement_Entity (N));
                      Set_Uses_Sec_Stack (Func_Id);
                      Set_Uses_Sec_Stack (Return_Statement_Entity (N));
+                     Set_Sec_Stack_Needed_For_Return
+                       (Return_Statement_Entity (N));
+                     Set_Enclosing_Sec_Stack_Return (N);
 
                      --  Create an if statement to test the BIP_Alloc_Form
                      --  formal and initialize the access object to either the
@@ -5966,44 +5973,10 @@ package body Exp_Ch6 is
 
       else
          --  Prevent the reclamation of the secondary stack by all enclosing
-         --  blocks and loops as well as the related function, otherwise the
-         --  result will be reclaimed too early or even clobbered. Due to a
-         --  possible mix of internally generated blocks, source blocks and
-         --  loops, the scope stack may not be contiguous as all labels are
-         --  inserted at the top level within the related function. Instead,
-         --  perform a parent-based traversal and mark all appropriate
-         --  constructs.
-
-         declare
-            P : Node_Id;
-
-         begin
-            P := N;
-            while Present (P) loop
-
-               --  Mark the label of a source or internally generated block or
-               --  loop.
+         --  blocks and loops as well as the related function; otherwise the
+         --  result would be reclaimed too early.
 
-               if Nkind_In (P, N_Block_Statement, N_Loop_Statement) then
-                  Set_Sec_Stack_Needed_For_Return (Entity (Identifier (P)));
-
-               --  Mark the enclosing function
-
-               elsif Nkind (P) = N_Subprogram_Body then
-                  if Present (Corresponding_Spec (P)) then
-                     Set_Sec_Stack_Needed_For_Return (Corresponding_Spec (P));
-                  else
-                     Set_Sec_Stack_Needed_For_Return (Defining_Entity (P));
-                  end if;
-
-                  --  Do not go beyond the enclosing function
-
-                  exit;
-               end if;
-
-               P := Parent (P);
-            end loop;
-         end;
+         Set_Enclosing_Sec_Stack_Return (N);
 
          --  Optimize the case where the result is a function call. In this
          --  case either the result is already on the secondary stack, or is
@@ -9418,6 +9391,45 @@ package body Exp_Ch6 is
       end if;
    end Needs_Result_Accessibility_Level;
 
+   ------------------------------------
+   -- Set_Enclosing_Sec_Stack_Return --
+   ------------------------------------
+
+   procedure Set_Enclosing_Sec_Stack_Return (N : Node_Id) is
+      P : Node_Id := N;
+
+   begin
+      --  Due to a possible mix of internally generated blocks, source blocks
+      --  and loops, the scope stack may not be contiguous as all labels are
+      --  inserted at the top level within the related function. Instead,
+      --  perform a parent-based traversal and mark all appropriate constructs.
+
+      while Present (P) loop
+
+         --  Mark the label of a source or internally generated block or
+         --  loop.
+
+         if Nkind_In (P, N_Block_Statement, N_Loop_Statement) then
+            Set_Sec_Stack_Needed_For_Return (Entity (Identifier (P)));
+
+         --  Mark the enclosing function
+
+         elsif Nkind (P) = N_Subprogram_Body then
+            if Present (Corresponding_Spec (P)) then
+               Set_Sec_Stack_Needed_For_Return (Corresponding_Spec (P));
+            else
+               Set_Sec_Stack_Needed_For_Return (Defining_Entity (P));
+            end if;
+
+            --  Do not go beyond the enclosing function
+
+            exit;
+         end if;
+
+         P := Parent (P);
+      end loop;
+   end Set_Enclosing_Sec_Stack_Return;
+
    ------------------------
    -- Unnest_Subprograms --
    ------------------------
diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb
index 0216ddf..f0a9013 100644
--- a/gcc/ada/scng.adb
+++ b/gcc/ada/scng.adb
@@ -1834,14 +1834,19 @@ package body Scng is
 
          --  Apostrophe. This can either be the start of a character literal,
          --  or an isolated apostrophe used in a qualified expression or an
-         --  attribute. We treat it as a character literal if it does not
-         --  follow a right parenthesis, identifier, the keyword ALL or
-         --  a literal. This means that we correctly treat constructs like:
+         --  attribute. In the following:
 
          --    A := CHARACTER'('A');
 
-         --  Note that RM-2.2(7) does not require a separator between
-         --  "CHARACTER" and "'" in the above.
+         --  the first apostrophe is treated as an isolated apostrophe, and the
+         --  second one is treated as the start of the character literal 'A'.
+         --  Note that RM-2.2(7) does not require a separator between "'" and
+         --  "(" in the above, so we cannot use lookahead to distinguish the
+         --  cases; we use look-back instead. Analysis of the grammar shows
+         --  that some tokens can be followed by an apostrophe, and some by a
+         --  character literal, but none by both. Some cannot be followed by
+         --  either, so it doesn't matter what we do in those cases, except to
+         --  get good error behavior.
 
          when ''' => Char_Literal_Case : declare
             Code : Char_Code;
@@ -1851,17 +1856,18 @@ package body Scng is
             Accumulate_Checksum (''');
             Scan_Ptr := Scan_Ptr + 1;
 
-            --  Here is where we make the test to distinguish the cases. Treat
-            --  as apostrophe if previous token is an identifier, right paren
-            --  or the reserved word "all" (latter case as in A.all'Address)
-            --  (or the reserved word "project" in project files). Also treat
-            --  it as apostrophe after a literal (this catches some legitimate
-            --  cases, like A."abs"'Address, and also gives better error
-            --  behavior for impossible cases like 123'xxx).
+            --  Distinguish between apostrophe and character literal. It's an
+            --  apostrophe if the previous token is one of the following.
+            --  Reserved words are included for things like A.all'Address and
+            --  T'Digits'Img. Strings literals are included for things like
+            --  "abs"'Address. Other literals are included to give better error
+            --  behavior for illegal cases like 123'Img.
 
             if Prev_Token = Tok_Identifier
                or else Prev_Token = Tok_Right_Paren
                or else Prev_Token = Tok_All
+               or else Prev_Token = Tok_Delta
+               or else Prev_Token = Tok_Digits
                or else Prev_Token = Tok_Project
                or else Prev_Token in Token_Class_Literal
             then