OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.dg/] [interface_4.f90] - Blame information for rev 414

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 302 jeremybenn
! { dg-do run }
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.
5
!
6
! Contributed by Joost VandeVondele  and
7
! simplified by Tobias Burnus 
8
!
9
SUBROUTINE RECOPY(N, c)
10
  real, INTENT(IN) :: N
11
  character(6) :: c
12
  c = "recopy"
13
END SUBROUTINE RECOPY
14
 
15
MODULE f77_blas_extra
16
PUBLIC :: BL_COPY
17
INTERFACE BL_COPY
18
  MODULE PROCEDURE SDCOPY
19
END INTERFACE BL_COPY
20
CONTAINS
21
   SUBROUTINE SDCOPY(N, c)
22
    INTEGER, INTENT(IN) :: N
23
    character(6) :: c
24
    c = "sdcopy"
25
   END SUBROUTINE SDCOPY
26
END MODULE f77_blas_extra
27
 
28
MODULE f77_blas_generic
29
INTERFACE BL_COPY
30
   SUBROUTINE RECOPY(N, c)
31
    real, INTENT(IN) :: N
32
    character(6) :: c
33
   END SUBROUTINE RECOPY
34
END INTERFACE BL_COPY
35
END MODULE f77_blas_generic
36
 
37
program main
38
  USE f77_blas_extra
39
  USE f77_blas_generic
40
  character(6) :: chr
41
  call bl_copy(1, chr)
42
  if (chr /= "sdcopy") call abort ()
43
  call bl_copy(1.0, chr)
44
  if (chr /= "recopy") call abort ()
45
end program main
46
! { dg-final { cleanup-modules "f77_blas_generic f77_blas_extra" } }

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.