gcc/testsuite/gfortran.dg/result_in_spec_1.f90

   1 ! { dg-do run }
   2 ! Tests the check for PR31215, in which actual/formal interface
   3 ! was not being correctly handled for the size of 'r' because
   4 ! it is a result.
   5 !
   6 ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
   7 !
   8 module test1
   9   implicit none
  10 contains
  11   character(f(x)) function test2(x) result(r)
  12     implicit integer (x)
  13     dimension r(len(r)+1)
  14     integer, intent(in) :: x
  15     interface
  16       pure function f(x)
  17         integer, intent(in) :: x
  18         integer f
  19       end function f
  20     end interface
  21     integer i
  22     do i = 1, len(r)
  23       r(:)(i:i) = achar(mod(i,32)+iachar('@'))
  24     end do
  25   end function test2
  26 end module test1
  27
  28 program test
  29   use test1
  30   implicit none
  31 ! Original problem
  32   if (len(test2(10)) .ne. 21) call abort ()
  33 ! Check non-intrinsic calls are OK and check that fix does
  34 ! not confuse result variables.
  35   if (any (myfunc (test2(1)) .ne. "ABC")) call abort ()
  36 contains
  37   function myfunc (ch) result (chr)
  38     character (*) :: ch(:)
  39     character(len(ch)) :: chr(4)
  40     if (len (ch) .ne. 3) call abort ()
  41     if (any (ch .ne. "ABC")) call abort ()
  42     chr = test2 (1)
  43     if (len(test2(len(chr))) .ne. 7) call abort ()
  44   end function myfunc
  45 end program test
  46
  47 pure function f(x)
  48   integer, intent(in) :: x
  49   integer f
  50   f = 2*x+1
  51 end function f
  52 ! { dg-final { cleanup-modules "test1" } }