gcc/testsuite/gfortran.dg/import4.f90

   1 ! { dg-do run }
   2 ! Test for import in modules
   3 ! PR fortran/29601
   4
   5 subroutine bar(r)
   6   implicit none
   7   integer(8) :: r
   8   if(r /= 42) STOP 1
   9   r = 13
  10 end subroutine bar
  11
  12 subroutine foo(a)
  13   implicit none
  14   type myT
  15      sequence
  16      character(len=3) :: c
  17   end type myT
  18   type(myT) :: a
  19   if(a%c /= "xyz") STOP 2
  20   a%c = "abc"
  21 end subroutine
  22
  23 subroutine new(a,b)
  24   implicit none
  25   type gType
  26      sequence
  27      integer(8) :: c
  28   end type gType
  29   real(8) :: a
  30   type(gType) :: b
  31   if(a /= 99.0 .or. b%c /= 11) STOP 3
  32   a = -123.0
  33   b%c = -44
  34 end subroutine new
  35
  36 module general
  37   implicit none
  38   integer,parameter :: ikind = 8
  39   type gType
  40      sequence
  41      integer(ikind) :: c
  42   end type gType
  43 end module general
  44
  45 module modtest
  46   use general
  47   implicit none
  48   type myT
  49      sequence
  50      character(len=3) :: c
  51   end type myT
  52   integer, parameter :: dp = 8
  53   interface
  54      subroutine bar(x)
  55        import :: dp
  56        integer(dp) :: x
  57      end subroutine bar
  58      subroutine foo(c)
  59       import :: myT
  60        type(myT) :: c
  61      end subroutine foo
  62      subroutine new(x,y)
  63       import :: ikind,gType
  64       real(ikind) :: x
  65       type(gType) :: y
  66      end subroutine new
  67   end interface
  68   contains
  69   subroutine test
  70     integer(dp) :: y
  71     y = 42
  72     call bar(y)
  73     if(y /= 13) STOP 4
  74   end subroutine test
  75   subroutine test2()
  76     type(myT) :: z
  77     z%c = "xyz"
  78     call foo(z)
  79     if(z%c /= "abc") STOP 5
  80   end subroutine test2
  81 end module modtest
  82
  83 program all
  84   use modtest
  85   implicit none
  86   call test()
  87   call test2()
  88   call test3()
  89 contains
  90   subroutine test3()
  91     real(ikind) :: r
  92     type(gType) :: t
  93     r   = 99.0
  94     t%c = 11
  95     call new(r,t)
  96     if(r /= -123.0 .or. t%c /= -44) STOP 6
  97   end subroutine test3
  98 end program all