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/] [import4.f90] - Diff between revs 302 and 384

Go to most recent revision | Only display areas with differences | Details | Blame | View Log

Rev 302 Rev 384
! { dg-do run }
! { dg-do run }
! Test for import in modules
! Test for import in modules
! PR fortran/29601
! PR fortran/29601
subroutine bar(r)
subroutine bar(r)
  implicit none
  implicit none
  integer(8) :: r
  integer(8) :: r
  if(r /= 42) call abort()
  if(r /= 42) call abort()
  r = 13
  r = 13
end subroutine bar
end subroutine bar
subroutine foo(a)
subroutine foo(a)
  implicit none
  implicit none
  type myT
  type myT
     sequence
     sequence
     character(len=3) :: c
     character(len=3) :: c
  end type myT
  end type myT
  type(myT) :: a
  type(myT) :: a
  if(a%c /= "xyz") call abort()
  if(a%c /= "xyz") call abort()
  a%c = "abc"
  a%c = "abc"
end subroutine
end subroutine
subroutine new(a,b)
subroutine new(a,b)
  implicit none
  implicit none
  type gType
  type gType
     sequence
     sequence
     integer(8) :: c
     integer(8) :: c
  end type gType
  end type gType
  real(8) :: a
  real(8) :: a
  type(gType) :: b
  type(gType) :: b
  if(a /= 99.0 .or. b%c /= 11) call abort()
  if(a /= 99.0 .or. b%c /= 11) call abort()
  a = -123.0
  a = -123.0
  b%c = -44
  b%c = -44
end subroutine new
end subroutine new
module general
module general
  implicit none
  implicit none
  integer,parameter :: ikind = 8
  integer,parameter :: ikind = 8
  type gType
  type gType
     sequence
     sequence
     integer(ikind) :: c
     integer(ikind) :: c
  end type gType
  end type gType
end module general
end module general
module modtest
module modtest
  use general
  use general
  implicit none
  implicit none
  type myT
  type myT
     sequence
     sequence
     character(len=3) :: c
     character(len=3) :: c
  end type myT
  end type myT
  integer, parameter :: dp = 8
  integer, parameter :: dp = 8
  interface
  interface
     subroutine bar(x)
     subroutine bar(x)
       import :: dp
       import :: dp
       integer(dp) :: x
       integer(dp) :: x
     end subroutine bar
     end subroutine bar
     subroutine foo(c)
     subroutine foo(c)
      import :: myT
      import :: myT
       type(myT) :: c
       type(myT) :: c
     end subroutine foo
     end subroutine foo
     subroutine new(x,y)
     subroutine new(x,y)
      import :: ikind,gType
      import :: ikind,gType
      real(ikind) :: x
      real(ikind) :: x
      type(gType) :: y
      type(gType) :: y
     end subroutine new
     end subroutine new
  end interface
  end interface
  contains
  contains
  subroutine test
  subroutine test
    integer(dp) :: y
    integer(dp) :: y
    y = 42
    y = 42
    call bar(y)
    call bar(y)
    if(y /= 13) call abort()
    if(y /= 13) call abort()
  end subroutine test
  end subroutine test
  subroutine test2()
  subroutine test2()
    type(myT) :: z
    type(myT) :: z
    z%c = "xyz"
    z%c = "xyz"
    call foo(z)
    call foo(z)
    if(z%c /= "abc") call abort()
    if(z%c /= "abc") call abort()
  end subroutine test2
  end subroutine test2
end module modtest
end module modtest
program all
program all
  use modtest
  use modtest
  implicit none
  implicit none
  call test()
  call test()
  call test2()
  call test2()
  call test3()
  call test3()
contains
contains
  subroutine test3()
  subroutine test3()
    real(ikind) :: r
    real(ikind) :: r
    type(gType) :: t
    type(gType) :: t
    r   = 99.0
    r   = 99.0
    t%c = 11
    t%c = 11
    call new(r,t)
    call new(r,t)
    if(r /= -123.0 .or. t%c /= -44) call abort()
    if(r /= -123.0 .or. t%c /= -44) call abort()
  end subroutine test3
  end subroutine test3
end program all
end program all
! { dg-final { cleanup-modules "modtest general" } }
! { dg-final { cleanup-modules "modtest general" } }
 
 

powered by: WebSVN 2.1.0

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