From 37227150d2cce355321ebceeaca8e38dcf1de137 Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Tue, 11 Jun 2019 22:04:10 +0000 Subject: [PATCH] backport: re PR fortran/90744 (Bogus length for character temporaries passed to external procedures since r268992) MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit 2019-06-11 Thomas Koenig Tomáš Trnka Backport from trunk PR fortran/90744 * trans-types.c (get_formal_from_actual_arglist): Unset typespec flags which make no sense for procedures without explicit interface. 2019-06-11 Thomas Koenig Tomáš Trnka Backport from trunk PR fortran/90744 * gfortran.dg/deferred_character_33.f90: New test. * gfortran.dg/deferred_character_33a.f90: New test. Co-Authored-By: Tomáš Trnka From-SVN: r272173 --- gcc/fortran/ChangeLog | 9 +++++ gcc/fortran/trans-types.c | 3 ++ gcc/testsuite/ChangeLog | 8 +++++ .../gfortran.dg/deferred_character_33.f90 | 35 +++++++++++++++++++ .../gfortran.dg/deferred_character_33a.f90 | 9 +++++ 5 files changed, 64 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/deferred_character_33.f90 create mode 100644 gcc/testsuite/gfortran.dg/deferred_character_33a.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 49f9fc0e34c2..a068c5d3635d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2019-06-11 Thomas Koenig + Tomáš Trnka + + Backport from trunk + PR fortran/90744 + * trans-types.c (get_formal_from_actual_arglist): Unset typespec + flags which make no sense for procedures without explicit + interface. + 2019-05-30 Marek Polacek * lang.opt (ftail-call-workaround): Fix a typo. diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 22410b551e6c..17dc12f51f8c 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -3005,6 +3005,9 @@ get_formal_from_actual_arglist (gfc_symbol *sym, gfc_actual_arglist *actual_args else { s->ts = a->expr->ts; + s->ts.deferred = 0; + s->ts.is_iso_c = 0; + s->ts.is_c_interop = 0; s->attr.flavor = FL_VARIABLE; if (a->expr->rank > 0) { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 96e2b3d62616..7ff549d0634e 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2019-06-11 Thomas Koenig + Tomáš Trnka + + Backport from trunk + PR fortran/90744 + * gfortran.dg/deferred_character_33.f90: New test. + * gfortran.dg/deferred_character_33a.f90: New test. + 2019-06-11 Jakub Jelinek PR c++/90810 diff --git a/gcc/testsuite/gfortran.dg/deferred_character_33.f90 b/gcc/testsuite/gfortran.dg/deferred_character_33.f90 new file mode 100644 index 000000000000..ec864d83c314 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/deferred_character_33.f90 @@ -0,0 +1,35 @@ +! { dg-do run } +! { dg-additional-sources deferred_character_33a.f90 } +! PR fortran/90744 - this used to pass a wrong length +! to an external function without a prototype. +! Original test case by Tomáš Trnka. +module StringModule + implicit none + +contains + function getstr() + character(:), allocatable :: getstr + + getstr = 'OK' + end function +end module +module TestModule + use StringModule + implicit none + +contains + subroutine DoTest() + if (.false.) then + call convrs('A',getstr()) + else + call convrs('B',getstr()) + end if + end subroutine +end module +program external_char_length + use TestModule + + implicit none + + call DoTest() +end program diff --git a/gcc/testsuite/gfortran.dg/deferred_character_33a.f90 b/gcc/testsuite/gfortran.dg/deferred_character_33a.f90 new file mode 100644 index 000000000000..db117cc0b381 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/deferred_character_33a.f90 @@ -0,0 +1,9 @@ +! { dg-do compile } +subroutine convrs(quanty,fromto) + implicit none + + character(*), intent(in) :: quanty,fromto + + if (len(fromto) /= 2) stop 1 + if (fromto /= 'OK') stop 2 +end subroutine -- 2.47.2