gcc/testsuite/gfortran.dg/module_procedure_4.f90

   1 ! { dg-do run }
   2 !
   3 ! Test the fix for PR96320 in which the assumed shape of 'arg' in the
   4 ! interface for 'bar' was mirrored by the 'arg' in the module procedure
   5 ! incorrectly have deferred shape.
   6 !
   7 ! Contributed by Damian Rouson  <damian@sourceryinstitute.org>
   8 !
   9 module foobar
  10   type foo
  11   contains
  12     procedure, nopass :: bar1
  13     procedure, nopass :: bar2
  14     procedure, nopass :: bar3
  15   end type
  16
  17   interface
  18
  19     module subroutine bar1(arg)
  20       character(len=*) arg(:)
  21     end subroutine
  22
  23     module subroutine bar2(arg)
  24       character(len=*) arg(3:)
  25     end subroutine
  26
  27     module subroutine bar3(arg)
  28       character(len=*) arg(2)
  29     end subroutine
  30
  31   end interface
  32 contains
  33
  34   module procedure bar1
  35     if (lbound(arg, 1) .ne. 1) stop 1
  36     if (arg(3) .ne. 'hijk') stop 2
  37   end procedure
  38
  39 ! Make sure that the lower bound of an assumed shape array dummy,
  40 ! if defined, is passed to the module procedure.
  41
  42   module procedure bar2
  43     if (lbound(arg, 1) .ne. 3) stop 3
  44     if (arg(3) .ne. 'abcd') stop 4
  45   end procedure
  46
  47 ! This makes sure that an dummy with explicit shape has the upper
  48 ! bound correctly set in the module procedure.
  49
  50   module procedure bar3
  51     if (lbound(arg, 1) .ne. 1) stop 5
  52     if (arg(3) .ne. 'hijk') stop 6       ! { dg-warning "is out of bounds" }
  53   end procedure
  54
  55 end module
  56
  57   use foobar
  58   character(4) :: list(3) = ['abcd', 'efgh' , 'hijk']
  59   type(foo) :: f
  60   call f%bar1(list)
  61   call f%bar2(list)
  62   call f%bar3(list)
  63 end