[gcc r17-3562] Fortran: Lost statement label in a program with a CONTAINS section [PR126909]

Paul Thomas via Gcc-cvs <[email protected]>
Newsgroups gmane.comp.gcc.cvs
Message-ID <[email protected]>
https://gcc.gnu.org/g:34762afa322a6556adfc7a83381a6f6ba5c3137b

commit r17-3562-g34762afa322a6556adfc7a83381a6f6ba5c3137b
Author: Paul Thomas <[email protected]>
Date:   Sun Aug 23 09:37:05 2026 +0100

    Fortran: Lost statement label in a program with a CONTAINS section [PR126909]
    
    2026-08-23  Paul Thomas  <[email protected]>
    
    gcc/fortran
            PR fortran/126909
            * parse.cc (accept_statement): After a contains section, a new
            namespace is started and, without correction, the new statement
            the label, if there is one, would be stored there.Go back to
            the containing namespace and store it there. Likewise add the
            labelled return statement to the previous entry on the state
            stack.
    gcc/testsuite
            PR fortran/126909
            * gfortran.dg/pr126909.f90: New test.

Diff:
---
 gcc/fortran/parse.cc                   | 28 ++++++++++++-
 gcc/testsuite/gfortran.dg/pr126909.f90 | 77 ++++++++++++++++++++++++++++++++++
 2 files changed, 103 insertions(+), 2 deletions(-)

diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index 47b443c4a5fb..311dfedabce1 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -3253,8 +3253,32 @@ accept_statement (gfc_statement st)
     case ST_END_SUBROUTINE:
       if (gfc_statement_label != NULL)
 	{
-	  new_st.op = EXEC_RETURN;
-	  add_statement ();
+	  /* After a contains section, a new namespace is started together with
+	     a new state_stack. The statement label must be attached to the
+	     previous state after finding the label in its namespace.  */
+	  if (gfc_state_stack->head == NULL
+	      && gfc_state_stack->previous
+	      && gfc_state_stack->previous->sym
+	      && gfc_state_stack->previous->sym->ns
+	      && gfc_state_stack->previous->sym->ns->parent == NULL)
+	    {
+	      int value = gfc_current_ns->st_labels->value;
+	      gfc_state_data *previous_state = gfc_state_stack;
+	      gfc_namespace *old_ns = gfc_current_ns;
+	      gfc_current_ns = gfc_state_stack->previous->sym->ns;
+	      new_st.here = gfc_get_st_label (value);
+	      new_st.here->defined = ST_LABEL_TARGET;
+	      new_st.op = EXEC_RETURN;
+	      gfc_state_stack = gfc_state_stack->previous;
+	      add_statement ();
+	      gfc_state_stack = previous_state;
+	      gfc_current_ns = old_ns;
+	    }
+	  else
+	   {
+	     new_st.op = EXEC_RETURN;
+	     add_statement ();
+	   }
 	}
       else
 	{
diff --git a/gcc/testsuite/gfortran.dg/pr126909.f90 b/gcc/testsuite/gfortran.dg/pr126909.f90
new file mode 100644
index 000000000000..b924fba1ce8f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr126909.f90
@@ -0,0 +1,77 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+!
+! Test the fix for PR126909, in which END PROGRAM/FUNCTION/SUBROUTINE labels
+! were not being generated correctly, when preceded by contain sections.
+!
+! Contributed by Steve Kargl  <[email protected]>
+!
+Module tally
+  integer :: ctr = 0
+contains
+  integer function two_power_n_plus (n, base)
+    integer, intent(IN) :: n, base
+    two_power_n_plus = 2**n  + base
+  end function two_power_n_plus
+end module
+
+program lost
+   use tally
+   interface
+      function yet_more_lost() result(i)
+         integer :: i
+      end function yet_more_lost
+   end interface
+
+   goto 9
+   stop 1
+9  ctr = two_power_n_plus (1, ctr)
+   call sub()
+   call more_lost()
+   if (yet_more_lost () /= 42) stop 2
+   if (ctr /= 126) stop 3
+   goto 10
+   stop 4
+   contains
+      subroutine sub()
+         ctr = two_power_n_plus (2, ctr)
+         goto 11
+         stop 5
+11    end subroutine sub
+10 end program lost
+
+subroutine more_lost
+   use tally
+   goto 9
+   stop 6
+9  ctr = two_power_n_plus (3, ctr)
+   call sub2()
+   goto 10
+   stop 7
+   contains
+      subroutine sub2()
+         ctr = two_power_n_plus (4, ctr)
+         goto 11
+         stop 8
+11    end subroutine sub2
+10 end subroutine more_lost
+
+function yet_more_lost() result(i)
+   use tally
+   integer :: i
+   i = 42
+   goto 9
+   stop 9
+9  ctr = two_power_n_plus (5, ctr)
+   call sub3()
+   goto 10
+   stop 10
+   contains
+      subroutine sub3()
+         ctr = two_power_n_plus (6, ctr)
+         goto 11
+         stop 11
+11    end subroutine sub3
+10 end function yet_more_lost
+
+! { dg-final { scan-tree-dump-times "label.000010" 6 "original" } }
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.