This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[patch, committed] PR 90744
- From: Thomas Koenig <tkoenig at netcologne dot de>
- To: "fortran at gcc dot gnu dot org" <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Sat, 8 Jun 2019 15:54:22 +0200
- Subject: [patch, committed] PR 90744
Hello world,
I have just committed the attached patch to trunk as obvious an simple.
The problem, which led to wrong code, was that copying the "deferred"
attribute from the dummy to the formal argument a) makes no sense b)
led to wrong code. The analysis and the first working version of the
patch was done by Tomáš Trnka (thanks!).
I will also backport, since this is a 7/8/9/10 regression.
Regards
Thomas
2019-06-08 Thomas Koenig <tkoenig@gcc.gnu.org>
Tomáš Trnka <trnka@scm.com>
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-08 Thomas Koenig <tkoenig@gcc.gnu.org>
Tomáš Trnka <trnka@scm.com>
PR fortran/90744
* gfortran.dg/deferred_character_33.f90: New test.
* gfortran.dg/deferred_character_33a.f90: New test.
Index: trans-types.c
===================================================================
--- trans-types.c (Revision 271945)
+++ trans-types.c (Arbeitskopie)
@@ -3005,6 +3005,9 @@ get_formal_from_actual_arglist (gfc_symbol *sym, g
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)
{
! { 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
! { 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