[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" } }