gcc/testsuite/gfortran.dg/value_1.f90

   1 ! { dg-do run }
   2 ! { dg-options "-std=f2003 -fall-intrinsics" }
   3 ! Tests the functionality of the patch for PR29642, which requested the
   4 ! implementation of the F2003 VALUE attribute for gfortran.
   5 !
   6 ! Contributed by Paul Thomas  <pault@gcc.gnu.org>
   7 !
   8 module global
   9   type :: mytype
  10     real(4) :: x
  11     character(4) :: c
  12   end type mytype
  13 contains
  14   subroutine typhoo (dt)
  15     type(mytype), value :: dt
  16     if (dtne (dt, mytype (42.0, "lmno"))) call abort ()
  17     dt = mytype (21.0, "wxyz")
  18     if (dtne (dt, mytype (21.0, "wxyz"))) call abort ()
  19   end subroutine typhoo
  20
  21   logical function dtne (a, b)
  22     type(mytype) :: a, b
  23     dtne = .FALSE.
  24     if ((a%x /= b%x) .or. (a%c /= b%c)) dtne = .TRUE.
  25   end function dtne
  26 end module global
  27
  28 program test_value
  29   use global
  30   integer(8) :: i = 42
  31   real(8) :: r = 42.0
  32   character(2) ::   c = "ab"
  33   complex(8) :: z = (-99.0, 199.0)
  34   type(mytype) :: dt = mytype (42.0, "lmno")
  35
  36   call foo (c)
  37   if (c /= "ab") call abort ()
  38
  39   call bar (i)
  40   if (i /= 42) call abort ()
  41
  42   call foobar (r)
  43   if (r /= 42.0) call abort ()
  44
  45   call complex_foo (z)
  46   if (z /= (-99.0, 199.0)) call abort ()
  47
  48   call typhoo (dt)
  49   if (dtne (dt, mytype (42.0, "lmno"))) call abort ()
  50
  51   r = 20.0
  52   call foobar (r*2.0 + 2.0)
  53
  54 contains
  55   subroutine foo (c)
  56     character(2), value :: c
  57     if (c /= "ab") call abort ()
  58     c = "cd"
  59     if (c /= "cd") call abort ()
  60   end subroutine foo
  61
  62   subroutine bar (i)
  63     integer(8), value :: i
  64     if (i /= 42) call abort ()
  65     i = 99
  66     if (i /= 99) call abort ()
  67   end subroutine bar
  68
  69   subroutine foobar (r)
  70     real(8), value :: r
  71     if (r /= 42.0) call abort ()
  72     r = 99.0
  73     if (r /= 99.0) call abort ()
  74   end subroutine foobar
  75
  76   subroutine complex_foo (z)
  77     COMPLEX(8), value :: z
  78     if (z /= (-99.0, 199.0)) call abort ()
  79     z = (77.0, -42.0)
  80     if (z /= (77.0, -42.0)) call abort ()
  81   end subroutine complex_foo
  82
  83 end program test_value