gcc/testsuite/gfortran.dg/interface_5.f90

   1 ! { dg-do compile }
   2 ! Tests the fix for the interface bit of PR29975, in which the
   3 ! interfaces bl_copy were rejected as ambiguous, even though
   4 ! they import different specific interfaces.  In this testcase,
   5 ! it is verified that ambiguous specific interfaces are caught.
   6 !
   7 ! Contributed by Joost VandeVondele <jv244@cam.ac.uk> and
   8 ! simplified by Tobias Burnus <burnus@gcc.gnu.org>
   9 !
  10 SUBROUTINE RECOPY(N, c)
  11   real, INTENT(IN) :: N
  12   character(6) :: c
  13   print *, n
  14   c = "recopy"
  15 END SUBROUTINE RECOPY
  16
  17 MODULE f77_blas_extra
  18 PUBLIC :: BL_COPY
  19 INTERFACE BL_COPY
  20   MODULE PROCEDURE SDCOPY
  21 END INTERFACE BL_COPY
  22 CONTAINS
  23    SUBROUTINE SDCOPY(N, c)
  24     REAL, INTENT(IN) :: N
  25     character(6) :: c
  26     print *, n
  27     c = "sdcopy"
  28    END SUBROUTINE SDCOPY
  29 END MODULE f77_blas_extra
  30
  31 MODULE f77_blas_generic
  32 INTERFACE BL_COPY
  33    SUBROUTINE RECOPY(N, c)
  34     real, INTENT(IN) :: N
  35     character(6) :: c
  36    END SUBROUTINE RECOPY
  37 END INTERFACE BL_COPY
  38 END MODULE f77_blas_generic
  39
  40 subroutine i_am_ok
  41   USE f77_blas_extra ! { dg-warning "ambiguous interfaces" }
  42   USE f77_blas_generic
  43   character(6) :: chr
  44   chr = ""
  45   if (chr /= "recopy") call abort ()
  46 end subroutine i_am_ok
  47
  48 program main
  49   USE f77_blas_extra   ! { dg-error "Ambiguous interfaces" }
  50   USE f77_blas_generic ! { dg-error "Ambiguous interfaces" }
  51   character(6) :: chr
  52   chr = ""
  53   call bl_copy(1.0, chr)
  54   if (chr /= "recopy") call abort ()
  55 end program main