OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc2/] [gcc/] [testsuite/] [gfortran.dg/] [host_assoc_call_3.f90] - Rev 437

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

! { dg-do compile }
!
! PR fortran/37445, in which the contained 'putaline' would be
! ignored and no specific interface found in the generic version.
!
! Contributed by Norman S Clerman < clerman@fuse.net>
!
MODULE M1
  INTERFACE putaline
    MODULE PROCEDURE S1,S2
  END INTERFACE
CONTAINS
  SUBROUTINE S1(I)
      i = 3
  END SUBROUTINE
  SUBROUTINE S2(F)
      f = 4.0
  END SUBROUTINE
END MODULE

MODULE M2
  USE M1
CONTAINS
  SUBROUTINE S3
    integer :: check = 0
    CALL putaline()
    if (check .ne. 1) call abort
    CALL putaline("xx")
    if (check .ne. 2) call abort
!  CALL putaline(1.0) ! => this now causes an error, as it should 
  CONTAINS
    SUBROUTINE putaline(x)
      character, optional :: x
      if (present(x)) then
        check = 2
      else
        check = 1
      end if
    END SUBROUTINE
  END SUBROUTINE
  subroutine S4
    integer :: check = 0
    REAL :: rcheck = 0.0
    call putaline(check)
    if (check .ne. 3) call abort
    call putaline(rcheck)
    if (rcheck .ne. 4.0) call abort
  end subroutine s4
END MODULE

  USE M2
  CALL S3
  call S4
END
! { dg-final { cleanup-modules "M1 M2" } }

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

powered by: WebSVN 2.1.0

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