gcc/testsuite/gfortran.dg/host_assoc_call_3.f90

   1 ! { dg-do compile }
   2 !
   3 ! PR fortran/37445, in which the contained 'putaline' would be
   4 ! ignored and no specific interface found in the generic version.
   5 !
   6 ! Contributed by Norman S Clerman < clerman@fuse.net>
   7 !
   8 MODULE M1
   9   INTERFACE putaline
  10     MODULE PROCEDURE S1,S2
  11   END INTERFACE
  12 CONTAINS
  13   SUBROUTINE S1(I)
  14       i = 3
  15   END SUBROUTINE
  16   SUBROUTINE S2(F)
  17       f = 4.0
  18   END SUBROUTINE
  19 END MODULE
  20
  21 MODULE M2
  22   USE M1
  23 CONTAINS
  24   SUBROUTINE S3
  25     integer :: check = 0
  26     CALL putaline()
  27     if (check .ne. 1) call abort
  28     CALL putaline("xx")
  29     if (check .ne. 2) call abort
  30 !  CALL putaline(1.0) ! => this now causes an error, as it should
  31   CONTAINS
  32     SUBROUTINE putaline(x)
  33       character, optional :: x
  34       if (present(x)) then
  35         check = 2
  36       else
  37         check = 1
  38       end if
  39     END SUBROUTINE
  40   END SUBROUTINE
  41   subroutine S4
  42     integer :: check = 0
  43     REAL :: rcheck = 0.0
  44     call putaline(check)
  45     if (check .ne. 3) call abort
  46     call putaline(rcheck)
  47     if (rcheck .ne. 4.0) call abort
  48   end subroutine s4
  49 END MODULE
  50
  51   USE M2
  52   CALL S3
  53   call S4
  54 END
  55 ! { dg-final { cleanup-modules "M1 M2" } }