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  <tkoe...@gcc.gnu.org>
        Tomáš Trnka  <tr...@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  <tkoe...@gcc.gnu.org>
        Tomáš Trnka  <tr...@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

Reply via email to