gcc/testsuite/gfortran.dg/actual_pointer_function_1.f90

   1 ! { dg-do run }
   2 ! Tests the fix for PR31211, in which the value of the result for
   3 ! cp_get_default_logger was stored as a temporary, rather than the
   4 ! pointer itself.  This caused a segfault when the result was
   5 ! nullified.
   6 !
   7 ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
   8 !
   9   TYPE cp_logger_type
  10     INTEGER :: a
  11   END TYPE cp_logger_type
  12
  13   if (cp_logger_log(cp_get_default_logger (0))) STOP 1
  14   if (.not. cp_logger_log(cp_get_default_logger (42))) STOP 2
  15
  16 CONTAINS
  17
  18   logical function cp_logger_log(logger)
  19     TYPE(cp_logger_type), POINTER ::logger
  20     if (associated (logger)) then
  21       cp_logger_log = (logger%a .eq. 42)
  22     else
  23       cp_logger_log = .false.
  24     end if
  25   END function
  26
  27   FUNCTION cp_get_default_logger(v) RESULT(res)
  28     TYPE(cp_logger_type), POINTER ::res
  29     integer :: v
  30     if (v .eq. 0) then
  31       NULLIFY(RES)
  32     else
  33       allocate(RES)
  34       res%a = v
  35     end if
  36   END FUNCTION cp_get_default_logger
  37 END