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!
10SUBROUTINE RECOPY(N, c)
11  real, INTENT(IN) :: N
12  character(6) :: c
13  print *, n
14  c = "recopy"
15END SUBROUTINE RECOPY
16
17MODULE f77_blas_extra
18PUBLIC :: BL_COPY
19INTERFACE BL_COPY
20  MODULE PROCEDURE SDCOPY
21END INTERFACE BL_COPY
22CONTAINS
23   SUBROUTINE SDCOPY(N, c)
24    REAL, INTENT(IN) :: N
25    character(6) :: c
26    print *, n
27    c = "sdcopy"
28   END SUBROUTINE SDCOPY
29END MODULE f77_blas_extra
30
31MODULE f77_blas_generic
32INTERFACE BL_COPY
33   SUBROUTINE RECOPY(N, c)
34    real, INTENT(IN) :: N
35    character(6) :: c
36   END SUBROUTINE RECOPY
37END INTERFACE BL_COPY
38END MODULE f77_blas_generic
39
40subroutine 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 ()
46end subroutine i_am_ok
47
48program main
49  USE f77_blas_extra ! { dg-error "Ambiguous interfaces" }
50  USE f77_blas_generic
51  character(6) :: chr
52  chr = ""
53  call bl_copy(1.0, chr)
54  if (chr /= "recopy") call abort ()
55end program main
56