common/memory_utilities: add test for string arrays

cp2k · Nov 6, 2020 · 073d098 · 073d098
1 parent f202247
commit 073d098
Show file tree

Hide file tree

Showing 3 changed files with 51 additions and 6 deletions.
diff --git a/src/common/memory_utilities.F b/src/common/memory_utilities.F
@@ -13,9 +13,7 @@
 ! **************************************************************************************************
 MODULE memory_utilities
 
-   USE kinds, ONLY: default_path_length, &
-                    default_string_length, &
-                    dp, int_8
+   USE kinds, ONLY: dp, int_8
 #include "../base/base_uses.f90"
 
    IMPLICIT NONE
@@ -73,7 +71,8 @@ SUBROUTINE reallocate_${suffix}$${rank}$ (p, ${bounds_vars}$)
          #:endif
          DIMENSION(${arr_exp}$), &
          POINTER :: work
-      work => NULL()
+
+      NULLIFY (work)
 
       IF (ASSOCIATED(p)) THEN
 #:for i in range(1, rank+1)

diff --git a/src/common/memory_utilities_unittest.F b/src/common/memory_utilities_unittest.F
@@ -17,6 +17,8 @@ PROGRAM memory_utilities_TEST
    CALL check_real_rank2_allocated()
    CALL check_real_rank2_unallocated()
 
+   CALL check_string_rank1_allocated()
+   CALL check_string_rank1_unallocated()
 CONTAINS
 ! **************************************************************************************************
 !> \brief Check that an allocated r1 array can be extended
@@ -47,7 +49,7 @@ SUBROUTINE check_real_rank1_allocated()
    SUBROUTINE check_real_rank1_unallocated()
       REAL(KIND=dp), DIMENSION(:), POINTER               :: real_arr
 
-      real_arr => NULL()
+      NULLIFY (real_arr)
 
       CALL reallocate(real_arr, 1, 20)
 
@@ -88,7 +90,7 @@ SUBROUTINE check_real_rank2_allocated()
    SUBROUTINE check_real_rank2_unallocated()
       REAL(KIND=dp), DIMENSION(:, :), POINTER            :: real_arr
 
-      real_arr => NULL()
+      NULLIFY (real_arr)
 
       CALL reallocate(real_arr, 1, 10, 1, 5)
 
@@ -99,5 +101,47 @@ SUBROUTINE check_real_rank2_unallocated()
 
       PRINT *, "check_real_rank2_unallocated: OK"
    END SUBROUTINE
+
+! **************************************************************************************************
+!> \brief Check that an allocated string array can be extended
+! **************************************************************************************************
+   SUBROUTINE check_string_rank1_allocated()
+      CHARACTER(LEN=12), DIMENSION(:), POINTER           :: str_arr
+      INTEGER                                            :: idx
+
+      ALLOCATE (str_arr(10))
+      str_arr = [("hello, there", idx=1, 10)]
+
+      CALL reallocate(str_arr, 1, 20)
+
+      IF (.NOT. ALL(str_arr(1:10) == [("hello, there", idx=1, 10)])) &
+         ERROR STOP "check_string_rank1_allocated: reallocating changed the initial values"
+
+      IF (.NOT. ALL(str_arr(11:20) == "")) &
+         ERROR STOP "check_string_rank1_allocated: reallocation failed to initialise new values with ''."
+
+      DEALLOCATE (str_arr)
+
+      PRINT *, "check_string_rank1_allocated: OK"
+   END SUBROUTINE
+
+! **************************************************************************************************
+!> \brief Check that an unallocated string array can be extended
+! **************************************************************************************************
+   SUBROUTINE check_string_rank1_unallocated()
+      CHARACTER(LEN=12), DIMENSION(:), POINTER           :: str_arr
+
+      NULLIFY (str_arr)
+
+      CALL reallocate(str_arr, 1, 20)
+
+      IF (.NOT. ALL(str_arr(1:20) == "")) &
+         ERROR STOP "check_string_rank1_allocated: reallocation failed to initialise new values with ''."
+
+      DEALLOCATE (str_arr)
+
+      PRINT *, "check_string_rank1_unallocated: OK"
+   END SUBROUTINE
+
 END PROGRAM
 ! vim: set ts=3 sw=3 tw=132 :
diff --git a/tools/conventions/conventions.supp b/tools/conventions/conventions.supp
@@ -251,3 +251,5 @@ memory_utilities_unittest.F: Found WRITE statement with hardcoded unit in "check
 memory_utilities_unittest.F: Found WRITE statement with hardcoded unit in "check_real_rank1_unallocated"
 memory_utilities_unittest.F: Found WRITE statement with hardcoded unit in "check_real_rank2_allocated"
 memory_utilities_unittest.F: Found WRITE statement with hardcoded unit in "check_real_rank2_unallocated"
+memory_utilities_unittest.F: Found WRITE statement with hardcoded unit in "check_string_rank1_allocated"
+memory_utilities_unittest.F: Found WRITE statement with hardcoded unit in "check_string_rank1_unallocated"