gcc/testsuite/gfortran.dg/function_kinds_1.f90

   1 ! { dg-do run }
   2 ! Tests the fix for PR31229, PR31154 and PR33334, in which
   3 ! the KIND and TYPE parameters in the function declarations
   4 ! would cause errors.
   5 !
   6 ! Contributed by Brooks Moses <brooks@gcc.gnu.org>
   7 !           and Tobias Burnus <burnus@gcc.gnu.org>
   8 !
   9 module kinds
  10   implicit none
  11   integer, parameter :: dp = selected_real_kind(6)
  12   type t
  13      integer :: i
  14   end type t
  15   interface
  16     real(dp) function y()
  17       import
  18     end function
  19   end interface
  20 end module kinds
  21
  22 type(t) function func() ! The legal bit of PR33334
  23   use kinds
  24   func%i = 5
  25 end function func
  26
  27 real(dp) function another_dp_before_defined ()
  28   use kinds
  29   another_dp_before_defined = real (kind (4.0_DP))
  30 end function
  31
  32 module mymodule;
  33 contains
  34   REAL(2*DP) function declared_dp_before_defined()
  35     use kinds, only: dp
  36     real (dp) :: x
  37     declared_dp_before_defined = 1.0_dp
  38     x = 1.0_dp
  39     declared_dp_before_defined = real (kind (x))
  40   end function
  41 end module mymodule
  42
  43   use kinds
  44   use mymodule
  45   type(t), external :: func
  46   type(t) :: z
  47   if (kind (y ()) .ne. 4) STOP 1
  48   if (kind (declared_dp_before_defined ()) .ne. 8) STOP 2
  49   if (int (declared_dp_before_defined ()) .ne. 4) STOP 3
  50   if (int (another_dp_before_defined ()) .ne. 4) STOP 4
  51   z = func()
  52   if (z%i .ne. 5) STOP 5
  53 end