0-size allocations for owned fields

host_alloc_module.fypp

@@ -71,19 +71,23 @@ SUBROUTINE ${ft.name}$_HOST_ALLOC (HST, LBOUNDS, UBOUNDS, PINNED)
    ARR_SIZE = ARR_SIZE * ISHAPE(${r+1}$)
 #:endfor
 
-   CALL C_MALLOC(ARR_SIZE, DATA)
+   IF(ARR_SIZE > 0)THEN
+     CALL C_MALLOC(ARR_SIZE, DATA)
 
 #:if defined('CUDA')
-   IF(PINNED)THEN
-     ISTAT = CUDAHOSTREGISTER (DATA, ARR_SIZE, CUDAHOSTREGISTERMAPPED)
-     IF (ISTAT /= 0) THEN
-       CALL FIELD_ABORT ("${ft.name}$_OWNER: FAILED TO REGISTER IN PAGE-LOCKED MEMORY")
+     IF(PINNED)THEN
+       ISTAT = CUDAHOSTREGISTER (DATA, ARR_SIZE, CUDAHOSTREGISTERMAPPED)
+       IF (ISTAT /= 0) THEN
+         CALL FIELD_ABORT ("${ft.name}$_OWNER: FAILED TO REGISTER IN PAGE-LOCKED MEMORY")
+       ENDIF
      ENDIF
-   ENDIF
 #:endif
 
-   CALL C_F_POINTER(DATA, PTR, SHAPE=ISHAPE)
-   HST(${', '.join(map(lambda r: 'LBOUNDS('+str(r+1)+'):', range(0, ft.rank)))}$) => PTR
+     CALL C_F_POINTER(DATA, PTR, SHAPE=ISHAPE)
+     HST(${', '.join(map(lambda r: 'LBOUNDS('+str(r+1)+'):', range(0, ft.rank)))}$) => PTR
+   ELSE
+     ALLOCATE(HST(${','.join([f'LBOUNDS({r+1}):UBOUNDS({r+1})' for r in range(ft.rank)])}$))
+   ENDIF
 
 END SUBROUTINE ${ft.name}$_HOST_ALLOC
 
@@ -97,20 +101,24 @@ SUBROUTINE ${ft.name}$_HOST_DEALLOC(HST, PINNED)
    TYPE(C_PTR) :: DATA
    INTEGER :: ISTAT
 
-   DATA = C_LOC (HST (${ ', '.join (map (lambda i: 'LBOUND (HST, ' + str (i) + ')', range (1, ft.rank+1))) }$))
+   IF(SIZE(HST) > 0)THEN
+     DATA = C_LOC (HST (${ ', '.join (map (lambda i: 'LBOUND (HST, ' + str (i) + ')', range (1, ft.rank+1))) }$))
 
 #:if defined('CUDA')
-   IF (PINNED) THEN
-     ISTAT = CUDAHOSTUNREGISTER (DATA)
-     IF (ISTAT /= 0) THEN
-       CALL FIELD_ABORT ("${ft.name}$_OWNER: FAILED TO UNREGISTER PAGE-LOCKED MEMORY")
+     IF (PINNED) THEN
+       ISTAT = CUDAHOSTUNREGISTER (DATA)
+       IF (ISTAT /= 0) THEN
+         CALL FIELD_ABORT ("${ft.name}$_OWNER: FAILED TO UNREGISTER PAGE-LOCKED MEMORY")
+       ENDIF
      ENDIF
-   ENDIF
 #:endif
 
-   NULLIFY(HST)
+     CALL C_FREE(DATA)
+   ELSE
+     DEALLOCATE(HST)
+   ENDIF
 
-   CALL C_FREE(DATA)
+   NULLIFY(HST)
 
 END SUBROUTINE ${ft.name}$_HOST_DEALLOC
 

tests/CMakeLists.txt

@@ -25,9 +25,9 @@ target_compile_definitions( main.x PRIVATE $<${HAVE_CUDA}:_CUDA> )
 
 ## Unit tests
 list(APPEND TEST_FILES
-        test_wrappernosynconfinal.F90
-        test_field1d.F90
-        test_pinned.F90
+	test_wrappernosynconfinal.F90
+	test_field1d.F90
+	test_pinned.F90
 	async_host.F90
 	cpu_to_gpu.F90
 	cpu_to_gpu_delayed_init_value.F90
@@ -45,6 +45,7 @@ list(APPEND TEST_FILES
 	get_view_when_uninitialized.F90
 	init_owner.F90
 	init_owner2.F90
+	init_owner_0_size.F90
 	init_owner_delayed.F90
 	init_owner_delayed_gpu.F90
 	init_owner_delayed_init_debug_value.F90
@@ -70,7 +71,7 @@ list(APPEND TEST_FILES
 	sync_host.F90
 	test_crc64.F90
 	wrapper_modify_gpu.F90
-        test_gang.F90
+	test_gang.F90
 	)
 
 #Place-holder for failing tests

tests/init_owner_0_size.F90

@@ -0,0 +1,28 @@
+! (C) Copyright 2022- ECMWF.
+! (C) Copyright 2022- Meteo-France.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+PROGRAM INIT_OWNER_0_SIZE
+        ! TEST IF 0-SIZED ALLOCATION IS HANDLED SAFELY
+
+        USE FIELD_MODULE
+        USE FIELD_FACTORY_MODULE
+        USE PARKIND1
+        USE FIELD_ABORT_MODULE
+        IMPLICIT NONE
+        CLASS(FIELD_2RB), POINTER :: O => NULL()
+        REAL(KIND=JPRB), POINTER :: PTR(:,:)
+
+        CALL FIELD_NEW(O, LBOUNDS=[22,1], UBOUNDS=[21,11], PERSISTENT=.TRUE., DELAYED=.FALSE.)
+
+        IF(.NOT. SIZE(O%PTR) == 0) CALL FIELD_ABORT("ERROR")
+
+        CALL O%SYNC_HOST_RDWR
+
+        CALL FIELD_DELETE(O)
+END PROGRAM INIT_OWNER_0_SIZE