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))) call abort ()
  14   if (.not. cp_logger_log(cp_get_default_logger (42))) call abort ()
  15
  16 CONTAINS
  17
  18   logical function cp_logger_log(logger)
  19     TYPE(cp_logger_type), POINTER ::logger
  20     cp_logger_log = associated (logger) .and. (logger%a .eq. 42)
  21   END function
  22
  23   FUNCTION cp_get_default_logger(v) RESULT(res)
  24     TYPE(cp_logger_type), POINTER ::res
  25     integer :: v
  26     if (v .eq. 0) then
  27       NULLIFY(RES)
  28     else
  29       allocate(RES)
  30       res%a = v
  31     end if
  32   END FUNCTION cp_get_default_logger
  33 END