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/] [host_assoc_call_3.f90] - Blame information for rev 302

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 302 jeremybenn
! { 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" } }

powered by: WebSVN 2.1.0

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