gcc/testsuite/gfortran.dg/dec_structure_7.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fdec-structure" }
   3 !
   4 ! Test passing STRUCTUREs through functions and subroutines.
   5 !
   6
   7 subroutine aborts (s)
   8   character(*), intent(in) :: s
   9   print *, s
  10   call abort()
  11 end subroutine
  12
  13 module dec_structure_7m
  14   structure /s1/
  15     integer i1
  16     logical l1
  17     real r1
  18     character c1
  19   end structure
  20
  21   structure /s2/
  22     integer i
  23     record /s1/ r1
  24   endstructure
  25
  26 contains
  27   ! Pass structure through subroutine
  28   subroutine sub (rec1, i)
  29     implicit none
  30     integer, intent(in) :: i
  31     record /s1/ rec1
  32     rec1.i1 = i
  33   end subroutine
  34
  35   ! Pass structure through function
  36   function func (rec2, r)
  37     implicit none
  38     real, intent(in) :: r
  39     record /s2/ rec2
  40     real func
  41     rec2.r1.r1 = r
  42     func = rec2.r1.r1
  43     return
  44   end function
  45 end module
  46
  47 program dec_structure_7
  48   use dec_structure_7m
  49
  50   implicit none
  51   record /s1/ r1
  52   record /s2/ r2
  53   real junk
  54
  55   ! Passing through functions and subroutines
  56   r1.i1 = 0
  57   call sub (r1, 10)
  58
  59   r2.r1.r1 = 0.0
  60   junk = func (r2, -20.14)
  61
  62   if (r1.i1 .ne. 10) then
  63     call aborts("sub(r1, 10)")
  64   endif
  65
  66   if (r2.r1.r1 .ne. -20.14) then
  67     call aborts("func(r2, -20.14)")
  68   endif
  69
  70   if (junk .ne. -20.14) then
  71     print *, junk
  72     call aborts("junk = func()")
  73   endif
  74
  75 end program