gcc/testsuite/gfortran.dg/dec_parameter_1.f

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