Fix: don't try to cleanup uninitialised programs and kernels

LKedward · Jul 10, 2023 · 3ebce5a · 3ebce5a
1 parent b166698
commit 3ebce5a
Show file tree

Hide file tree

Showing 2 changed files with 12 additions and 6 deletions.
diff --git a/src/Focal.f90 b/src/Focal.f90
@@ -147,7 +147,7 @@ module Focal
   type :: fclProgram
     !! Type wrapper for openCL program objects
     private
-    integer(c_intptr_t) :: cl_program                !! openCL program pointer
+    integer(c_intptr_t) :: cl_program = -1                !! openCL program pointer
     contains
     final :: fclReleaseProgram
   end type fclProgram
@@ -204,7 +204,7 @@ module Focal
 
   type, extends(fclProfileContainer) :: fclKernel
     !! Type wrapper for openCL kernel objects
-    integer(c_intptr_t), private :: cl_kernel        !! openCL kernel pointer
+    integer(c_intptr_t), private :: cl_kernel = -1        !! openCL kernel pointer
     character(:), allocatable :: name                !! Kernel name
     integer(c_int32_t) :: work_dim = 1               !! Number of work-range dimensions
     integer(c_size_t) :: global_work_offset(3) = 0   !! Global work dimension offsets

diff --git a/src/Focal_Setup.f90 b/src/Focal_Setup.f90
@@ -628,8 +628,11 @@
     !! Release underlying memory associated with OpenCL program pointer
 
     integer :: errcode
-    errcode = clReleaseProgram(prog%cl_program)
-    call fclHandleError(errcode,'fclReleaseProgram','clReleaseProgram')
+
+    if (prog%cl_program /= -1) then
+      errcode = clReleaseProgram(prog%cl_program)
+      call fclHandleError(errcode,'fclReleaseProgram','clReleaseProgram')
+    end if
 
   end procedure fclReleaseProgram
   ! ---------------------------------------------------------------------------
@@ -1347,8 +1350,11 @@
   module procedure fclReleaseKernel !(kernel)
     !! Release OpenCL memory associated with underlying kernel pointer
     integer :: errcode
-    errcode = clReleaseKernel(kernel%cl_kernel)
-    call fclHandleError(errcode,'fclReleaseKernel','clReleaseKernel')
+
+    if (kernel%cl_kernel /= -1) then
+      errcode = clReleaseKernel(kernel%cl_kernel)
+      call fclHandleError(errcode,'fclReleaseKernel','clReleaseKernel')
+    end if
 
   end procedure fclReleaseKernel
   ! ---------------------------------------------------------------------------