gcc/testsuite/gfortran.dg/dec_parameter_2.f90

   1 ! { dg-do run }
   2 ! { dg-options "-ffree-form -std=legacy" }
   3 !
   4 ! Test DEC-style PARAMETER statements without parentheses in free form.
   5 !
   6
   7 subroutine sub1(t, x, y)
   8   implicit real(8) (A-H,O-Z)
   9   parameter   (pi_1 = 3.141592654d0, f_1 = 3.d08)
  10   parameter    pi_2 = 3.141592654d0, f_2 = 3.d08 ! legacy PARAMETER
  11   ! Note that if the parameter statements above are matched
  12   ! incorrectly as assignments, the below specification
  13   ! statements will be considered out-of-order and we see
  14   ! 'unexpected specification statement'. A PARAMETER
  15   ! statement should still be a specification statement.
  16
  17   real(8), intent(in) :: t
  18   real(8), intent(out) :: x, y
  19
  20   real(8), volatile :: two
  21   two = 2.0d0
  22   x = two * pi_1 * f_1 * t
  23   y = two * pi_2 * f_2 * t
  24   z = two * pi_3 * f_3 * t
  25   return
  26 end subroutine
  27
  28 subroutine sub2(t, x, y, z)
  29   implicit none
  30   real(8) :: pi_1, pi_2, f_1, f_2
  31            parameter   (pi_1 = 3.141592654d0, f_1 = 3.d08)
  32            parameter    pi_2 = 3.141592654d0, f_2 = 3.d08 ! legacy PARAMETER
  33   real(8), parameter :: pi_3 = 3.141592654d0, f_3 = 3.d08
  34   ! Ditto sub1
  35
  36   real(8), intent(in) :: t
  37   real(8), intent(out) :: x, y, z
  38
  39   real(8), volatile :: two
  40   two = 2.0d0
  41   x = two * pi_1 * f_1 * t
  42   y = two * pi_2 * f_2 * t
  43   z = two * pi_3 * f_3 * t
  44 end subroutine
  45
  46 implicit none
  47 real(8) :: x1, x2, y1, y2, z2
  48 real(8), volatile :: t
  49 t = 1.5e-6
  50
  51 call sub1(t, x1, y1)
  52 call sub2(t, x2, y2, z2)
  53
  54 write(*,'(4D18.5)') t, x1, y1
  55 write(*,'(4D18.5)') t, x2, y2, z2
  56
  57 if (x1 .ne. x2 .or. y1 .ne. y2 &
  58     .or. x1 .ne. y1 .or. x2 .ne. y2 &
  59     .or. y2 .ne. z2) then
  60   call abort()
  61 endif
  62
  63 end