gcc/testsuite/gfortran.dg/actual_pointer_function_1.f90

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