gcc/testsuite/gfortran.dg/pr32242.f90

   1 !PR fortran/32242
   2 ! { dg-do compile }
   3 ! { dg-final { cleanup-modules "kahan_sum" } }
   4
   5 MODULE kahan_sum
   6   INTEGER, PARAMETER :: dp=KIND(0.0D0)
   7   INTERFACE accurate_sum
   8     MODULE PROCEDURE kahan_sum_d1, kahan_sum_z1
   9   END INTERFACE accurate_sum
  10   TYPE pw_grid_type
  11      REAL (KIND=dp), DIMENSION ( : ), POINTER :: gsq
  12   END TYPE pw_grid_type
  13   TYPE pw_type
  14      REAL (KIND=dp), DIMENSION ( : ), POINTER :: cr
  15      COMPLEX (KIND=dp), DIMENSION ( : ), POINTER :: cc
  16      TYPE ( pw_grid_type ), POINTER :: pw_grid
  17   END TYPE pw_type
  18 CONTAINS
  19  FUNCTION kahan_sum_d1(array,mask) RESULT(ks)
  20    REAL(KIND=dp), DIMENSION(:), INTENT(IN)  :: array
  21    LOGICAL, DIMENSION(:), INTENT(IN), &
  22      OPTIONAL                               :: mask
  23    REAL(KIND=dp)                            :: ks
  24  END FUNCTION kahan_sum_d1
  25   FUNCTION kahan_sum_z1(array,mask) RESULT(ks)
  26     COMPLEX(KIND=dp), DIMENSION(:), &
  27       INTENT(IN)                             :: array
  28     LOGICAL, DIMENSION(:), INTENT(IN), &
  29       OPTIONAL                               :: mask
  30     COMPLEX(KIND=dp)                         :: ks
  31   END FUNCTION kahan_sum_z1
  32
  33 FUNCTION pw_integral_a2b ( pw1, pw2 ) RESULT ( integral_value )
  34     TYPE(pw_type), INTENT(IN)                :: pw1, pw2
  35     REAL(KIND=dp)                            :: integral_value
  36      integral_value = accurate_sum ( REAL ( CONJG ( pw1 % cc ( : ) ) &
  37           *  pw2 % cc ( : ) ,KIND=dp) * pw1 % pw_grid % gsq ( : ) )  ! { dg-warning "Function return value not set" }
  38 END FUNCTION pw_integral_a2b
  39 END MODULE