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) STOP 1
  28     CALL putaline("xx")
  29     if (check .ne. 2) STOP 2
  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) STOP 3
  46     call putaline(rcheck)
  47     if (rcheck .ne. 4.0) STOP 4
  48   end subroutine s4
  49 END MODULE
  50
  51   USE M2
  52   CALL S3
  53   call S4
  54 END