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           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
  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           STOP 1
  61         endif
  62
  63         end