├── .gitignore ├── .gitmodules ├── src ├── string.F90 ├── string_mod.F90 ├── string_test.F90 ├── string_actions_mod.F90 └── string_numerics_mod.F90 └── CMakeLists.txt /.gitignore: -------------------------------------------------------------------------------- 1 | build 2 | sftp-config.json -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "lib/unit-test"] 2 | path = lib/unit-test 3 | url = https://github.com/dongli/fortran-unit-test 4 | -------------------------------------------------------------------------------- /src/string.F90: -------------------------------------------------------------------------------- 1 | module string 2 | 3 | use string_mod 4 | use string_actions_mod 5 | use string_numerics_mod 6 | 7 | end module string 8 | -------------------------------------------------------------------------------- /CMakeLists.txt: -------------------------------------------------------------------------------- 1 | cmake_minimum_required(VERSION 3.0) 2 | 3 | project(fortran-string LANGUAGES Fortran) 4 | 5 | if (CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") 6 | set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ffree-line-length-none") 7 | if (CMAKE_BUILD_TYPE STREQUAL "Debug") 8 | set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -g -Wall -Wextra -Warray-temporaries -Wconversion -fimplicit-none -fbacktrace -fcheck=all -ffpe-trap=zero,overflow,underflow -finit-real=nan") 9 | else () 10 | set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ffpe-summary=none -Ofast") 11 | endif () 12 | endif () 13 | 14 | set (CMAKE_Fortran_MODULE_DIRECTORY "${CMAKE_BINARY_DIR}") 15 | include_directories(${CMAKE_BINARY_DIR}) 16 | 17 | get_directory_property(parent_dir PARENT_DIRECTORY) 18 | if (EXISTS ${PROJECT_SOURCE_DIR}/lib/unit-test/CMakeLists.txt AND NOT parent_dir) 19 | set(HAS_UNIT_TEST ON) 20 | add_subdirectory(lib/unit-test) 21 | endif () 22 | 23 | set(sources 24 | src/string_mod.F90 25 | src/string_actions_mod.F90 26 | src/string_numerics_mod.F90 27 | src/string.F90 28 | ) 29 | 30 | add_library(fortran_string ${sources}) 31 | 32 | if (HAS_UNIT_TEST) 33 | add_executable(string_test.exe src/string_test.F90) 34 | target_link_libraries(string_test.exe fortran_string fortran_unit_test) 35 | endif () 36 | -------------------------------------------------------------------------------- /src/string_mod.F90: -------------------------------------------------------------------------------- 1 | module string_mod 2 | 3 | implicit none 4 | 5 | private 6 | 7 | public string_type 8 | public assignment(=) 9 | public operator(//) 10 | 11 | type string_type 12 | character(:), allocatable :: value 13 | contains 14 | procedure :: at => string_at 15 | procedure :: len => string_len 16 | final :: string_final 17 | end type string_type 18 | 19 | interface assignment(=) 20 | module procedure string_assign_lhs 21 | module procedure string_assign_rhs 22 | end interface assignment(=) 23 | 24 | interface operator(//) 25 | module procedure string_cat_lhs 26 | module procedure string_cat_rhs 27 | end interface operator(//) 28 | 29 | contains 30 | 31 | pure subroutine string_assign_lhs(this, str) 32 | 33 | type(string_type), intent(inout) :: this 34 | character(*), intent(in) :: str 35 | 36 | if (allocated(this%value)) deallocate(this%value) 37 | this%value = str 38 | 39 | end subroutine string_assign_lhs 40 | 41 | pure subroutine string_assign_rhs(str, this) 42 | 43 | character(:), intent(out), allocatable :: str 44 | type(string_type), intent(in) :: this 45 | 46 | str = this%value 47 | 48 | end subroutine string_assign_rhs 49 | 50 | pure function string_cat_lhs(this, str) result(res) 51 | 52 | type(string_type), intent(in) :: this 53 | character(*), intent(in) :: str 54 | character(:), allocatable :: res 55 | 56 | res = trim(this%value) // trim(str) 57 | 58 | end function string_cat_lhs 59 | 60 | pure function string_cat_rhs(str, this) result(res) 61 | 62 | character(*), intent(in) :: str 63 | type(string_type), intent(in) :: this 64 | character(:), allocatable :: res 65 | 66 | res = trim(str) // trim(this%value) 67 | 68 | end function string_cat_rhs 69 | 70 | pure function string_at(this, start_pos, end_pos) result(res) 71 | 72 | class(string_type), intent(in) :: this 73 | integer, intent(in) :: start_pos 74 | integer, intent(in), optional :: end_pos 75 | character(:), allocatable :: res 76 | 77 | if (present(end_pos)) then 78 | res = this%value(start_pos:end_pos) 79 | else 80 | res = this%value(start_pos:start_pos) 81 | end if 82 | 83 | end function string_at 84 | 85 | pure integer function string_len(this) result(res) 86 | 87 | class(string_type), intent(in) :: this 88 | 89 | if (allocated(this%value)) then 90 | res = len_trim(this%value) 91 | else 92 | res = 0 93 | end if 94 | 95 | end function string_len 96 | 97 | subroutine string_final(this) 98 | 99 | type(string_type), intent(inout) :: this 100 | 101 | if (allocated(this%value)) deallocate(this%value) 102 | 103 | end subroutine string_final 104 | 105 | end module string_mod 106 | -------------------------------------------------------------------------------- /src/string_test.F90: -------------------------------------------------------------------------------- 1 | program string_test 2 | 3 | use unit_test 4 | use string 5 | 6 | implicit none 7 | 8 | call test_suite_init('String test') 9 | 10 | call test_string_type() 11 | 12 | call test_string_replace() 13 | 14 | call test_string_delete() 15 | 16 | call test_string_split() 17 | 18 | call test_string_basename() 19 | 20 | call test_string_to_str() 21 | 22 | call test_suite_report() 23 | 24 | call test_suite_final() 25 | 26 | contains 27 | 28 | subroutine test_string_type() 29 | 30 | type(string_type) s 31 | character(:), allocatable :: a 32 | 33 | call test_case_create('String type') 34 | 35 | s = 'abc' 36 | call assert_equal(len(s%value), 3, __FILE__, __LINE__) 37 | call assert_equal(s%value, 'abc', __FILE__, __LINE__) 38 | call assert_equal(s%at(1), 'a', __FILE__, __LINE__) 39 | 40 | a = s 41 | call assert_equal(len(a), 3, __FILE__, __LINE__) 42 | call assert_equal(a, 'abc', __FILE__, __LINE__) 43 | 44 | a = s // 'def' 45 | call assert_equal(len(a), 6, __FILE__, __LINE__) 46 | call assert_equal(a, 'abcdef', __FILE__, __LINE__) 47 | 48 | a = 'def' // s 49 | call assert_equal(len(a), 6, __FILE__, __LINE__) 50 | call assert_equal(a, 'defabc', __FILE__, __LINE__) 51 | 52 | end subroutine test_string_type 53 | 54 | subroutine test_string_replace() 55 | 56 | call test_case_create('String replace') 57 | 58 | call assert_equal(replace_string('data.txt', '.txt', ''), 'data', __FILE__, __LINE__) 59 | 60 | end subroutine test_string_replace 61 | 62 | subroutine test_string_delete() 63 | 64 | call test_case_create('String delete') 65 | 66 | call assert_equal(delete_string('data.nc', '.nc'), 'data', __FILE__, __LINE__) 67 | 68 | end subroutine test_string_delete 69 | 70 | subroutine test_string_split() 71 | 72 | type(string_type), allocatable :: fields(:) 73 | 74 | call test_case_create('String split') 75 | 76 | call assert_equal(count_string('a,b,d,d', ','), 3, __FILE__, __LINE__) 77 | call assert_equal(count_string('a//b//c', '//'), 2, __FILE__, __LINE__) 78 | call assert_equal(count_string('a b c', ' '), 2, __FILE__, __LINE__) 79 | 80 | fields = split_string('abc,,', ',') 81 | call assert_equal(size(fields), 2) 82 | call assert_equal(fields(1)%len(), 3, __FILE__, __LINE__) 83 | call assert_equal(fields(2)%len(), 0, __FILE__, __LINE__) 84 | call assert_equal(fields(1)%value, 'abc', __FILE__, __LINE__) 85 | call assert_equal(fields(2)%value, '', __FILE__, __LINE__) 86 | deallocate(fields) 87 | 88 | fields = split_string('/foo/bar/file', '/') 89 | call assert_equal(size(fields), 3) 90 | call assert_equal(fields(1)%len(), 3, __FILE__, __LINE__) 91 | call assert_equal(fields(2)%len(), 3, __FILE__, __LINE__) 92 | call assert_equal(fields(3)%len(), 4, __FILE__, __LINE__) 93 | call assert_equal(fields(1)%value, 'foo', __FILE__, __LINE__) 94 | call assert_equal(fields(2)%value, 'bar', __FILE__, __LINE__) 95 | call assert_equal(fields(3)%value, 'file', __FILE__, __LINE__) 96 | deallocate(fields) 97 | 98 | end subroutine test_string_split 99 | 100 | subroutine test_string_basename() 101 | 102 | call test_case_create('Basename') 103 | 104 | call assert_equal(basename('/foo/bar/file'), 'file', __FILE__, __LINE__) 105 | 106 | end subroutine test_string_basename 107 | 108 | subroutine test_string_to_str() 109 | 110 | call test_case_create('To string') 111 | 112 | call assert_equal(to_str(1), '1', __FILE__, __LINE__) 113 | call assert_equal(len(to_str(1)), 1, __FILE__, __LINE__) 114 | 115 | call assert_equal(to_str(-2), '-2', __FILE__, __LINE__) 116 | call assert_equal(len(to_str(-2)), 2, __FILE__, __LINE__) 117 | 118 | call assert_equal(to_str(.true.), 'true', __FILE__, __LINE__) 119 | call assert_equal(len(to_str(.true.)), 4, __FILE__, __LINE__) 120 | 121 | call assert_equal(to_str(1.245343, 2), '1.25', __FILE__, __LINE__) 122 | call assert_equal(to_str(1.245343, 2, 4), '1.25', __FILE__, __LINE__) 123 | call assert_equal(len(to_str(1.245343, 2, 4)), 4, __FILE__, __LINE__) 124 | call assert_equal(to_str(1.323D33, 2), '0.132E+34', __FILE__, __LINE__) 125 | 126 | call assert_equal(to_str([1.0d0, 2.0d0, 3.0d0], 1), '[1.0,2.0,3.0]', __FILE__, __LINE__) 127 | call assert_equal(len(to_str([1.0d0, 2.0d0, 3.0d0], 1)), 13, __FILE__, __LINE__) 128 | 129 | end subroutine test_string_to_str 130 | 131 | end program string_test 132 | -------------------------------------------------------------------------------- /src/string_actions_mod.F90: -------------------------------------------------------------------------------- 1 | module string_actions_mod 2 | 3 | use string_mod 4 | 5 | implicit none 6 | 7 | private 8 | 9 | public count_string 10 | public split_string 11 | public pad_string 12 | public replace_string 13 | public delete_string 14 | public dirname 15 | public basename 16 | 17 | interface count_string 18 | module procedure count_string_1 19 | end interface count_string 20 | 21 | interface split_string 22 | module procedure split_string_1 23 | module procedure split_string_2 24 | end interface split_string 25 | 26 | interface replace_string 27 | module procedure replace_string_1 28 | module procedure replace_string_2 29 | end interface replace_string 30 | 31 | interface delete_string 32 | module procedure delete_string_1 33 | end interface delete_string 34 | 35 | interface dirname 36 | module procedure dirname_1 37 | end interface dirname 38 | 39 | interface basename 40 | module procedure basename_1 41 | end interface basename 42 | 43 | contains 44 | 45 | pure integer function count_string_1(str, pattern) result(res) 46 | 47 | character(*), intent(in) :: str 48 | character(*), intent(in) :: pattern 49 | 50 | integer i, len_pat 51 | 52 | len_pat = len(pattern) 53 | res = 0 54 | i = 1 55 | do while (i <= len_trim(str)) 56 | if (i + len_pat - 1 > len_trim(str)) exit 57 | if (str(i:i+len_pat-1) == pattern) then 58 | res = res + 1 59 | i = i + len_pat 60 | else 61 | i = i + 1 62 | end if 63 | end do 64 | 65 | end function count_string_1 66 | 67 | pure function split_string_1(str, delim) result(res) 68 | 69 | character(*), intent(in) :: str 70 | character(*), intent(in) :: delim 71 | type(string_type), allocatable :: res(:) 72 | 73 | integer num_field, len_field, len_sep 74 | integer i1, i2 75 | 76 | len_sep = len(delim) 77 | 78 | num_field = 0; i1 = 1; i2 = 1 79 | do while (i2 <= len_trim(str)) 80 | if (str(i2:i2+len_sep-1) == delim) then 81 | if (i2 > 1) num_field = num_field + 1 82 | i2 = i2 + len_sep 83 | i1 = i2 84 | else if (i2 == len_trim(str)) then 85 | if (i1 > 0) num_field = num_field + 1 86 | exit 87 | else 88 | i2 = i2 + 1 89 | end if 90 | end do 91 | 92 | allocate(res(num_field)) 93 | 94 | num_field = 0; i1 = 1; i2 = 1 95 | do while (i2 <= len_trim(str)) 96 | if (str(i2:i2+len_sep-1) == delim) then 97 | if (i2 > 1) then 98 | num_field = num_field + 1 99 | res(num_field) = str(i1:i2-1) 100 | end if 101 | i2 = i2 + len_sep 102 | i1 = i2 103 | else if (i2 == len_trim(str)) then 104 | if (i1 > 0) then 105 | num_field = num_field + 1 106 | res(num_field) = str(i1:i2) 107 | end if 108 | exit 109 | else 110 | i2 = i2 + 1 111 | end if 112 | end do 113 | 114 | end function split_string_1 115 | 116 | pure function split_string_2(str, delim, index) result(res) 117 | 118 | character(*), intent(in) :: str 119 | character(*), intent(in) :: delim 120 | integer, intent(in) :: index 121 | character(:), allocatable :: res 122 | 123 | type(string_type), allocatable :: tmp(:) 124 | 125 | tmp = split_string_1(str, delim) 126 | 127 | res = trim(tmp(index)%value) 128 | 129 | end function split_string_2 130 | 131 | pure function pad_string(str, width) result(res) 132 | 133 | character(*), intent(in) :: str 134 | integer, intent(in) :: width 135 | character(width) res 136 | 137 | res = str 138 | 139 | end function pad_string 140 | 141 | pure function replace_string_1(str, pattern, replace) result(res) 142 | 143 | character(*), intent(in) :: str 144 | character(*), intent(in) :: pattern 145 | character(*), intent(in) :: replace 146 | character(:), allocatable :: res 147 | 148 | integer i 149 | 150 | i = index(str, pattern) 151 | 152 | allocate(character((len_trim(str)-len(pattern)+len_trim(replace)))::res) 153 | 154 | res = str(1:i-1) // trim(replace) // str(i+len(pattern):len_trim(str)) 155 | 156 | end function replace_string_1 157 | 158 | pure function replace_string_2(str, pattern, replace) result(res) 159 | 160 | type(string_type), intent(in) :: str 161 | character(*), intent(in) :: pattern 162 | character(*), intent(in) :: replace 163 | character(:), allocatable :: res 164 | 165 | res = replace_string_1(str%value, pattern, replace) 166 | 167 | end function replace_string_2 168 | 169 | pure function delete_string_1(str, pattern) result(res) 170 | 171 | character(*), intent(in) :: str 172 | character(*), intent(in) :: pattern 173 | character(:), allocatable :: res 174 | 175 | res = replace_string(str, pattern, '') 176 | 177 | end function delete_string_1 178 | 179 | pure function dirname_1(file_path) result(res) 180 | 181 | character(*), intent(in) :: file_path 182 | character(:), allocatable :: res 183 | 184 | res = replace_string(file_path, basename(file_path), '') 185 | 186 | end function dirname_1 187 | 188 | pure function basename_1(file_path, ext) result(res) 189 | 190 | character(*), intent(in) :: file_path 191 | character(*), intent(in), optional :: ext 192 | character(:), allocatable :: res 193 | 194 | type(string_type), allocatable :: fields(:) 195 | 196 | fields = split_string(trim(file_path), '/') 197 | 198 | if (present(ext)) then 199 | res = replace_string(fields(size(fields)), trim(ext), '') 200 | else 201 | res = fields(size(fields)) 202 | end if 203 | 204 | deallocate(fields) 205 | 206 | end function basename_1 207 | 208 | end module string_actions_mod 209 | -------------------------------------------------------------------------------- /src/string_numerics_mod.F90: -------------------------------------------------------------------------------- 1 | module string_numerics_mod 2 | 3 | implicit none 4 | 5 | private 6 | 7 | public to_str 8 | public to_int 9 | public to_r4 10 | public to_r8 11 | 12 | interface to_str 13 | module procedure i1_to_str 14 | module procedure i2_to_str 15 | module procedure i4_to_str 16 | module procedure i8_to_str 17 | module procedure i4_array_to_str 18 | module procedure r4_to_str 19 | module procedure r8_to_str 20 | module procedure r8_array_to_str 21 | module procedure l_to_str 22 | end interface to_str 23 | 24 | contains 25 | 26 | pure function i1_to_str(x) result(res) 27 | 28 | integer(1), intent(in) :: x 29 | character(:), allocatable :: res 30 | 31 | character(range(x)+2) tmp 32 | 33 | write(tmp, '(i0)') x 34 | res = trim(tmp) 35 | 36 | end function i1_to_str 37 | 38 | pure function i2_to_str(x) result(res) 39 | 40 | integer(2), intent(in) :: x 41 | character(:), allocatable :: res 42 | 43 | character(range(x)+2) tmp 44 | 45 | write(tmp, '(i0)') x 46 | res = trim(tmp) 47 | 48 | end function i2_to_str 49 | 50 | pure function i4_to_str(x, pad_zeros) result(res) 51 | 52 | integer(4), intent(in) :: x 53 | integer, intent(in), optional :: pad_zeros 54 | character(:), allocatable :: res 55 | 56 | character(range(x)+2) tmp 57 | character(256) fmt 58 | 59 | if (present(pad_zeros)) then 60 | if (pad_zeros > 0) then 61 | write(fmt, '("(i0.", i0, ")")') pad_zeros 62 | write(tmp, fmt) x 63 | else 64 | write(tmp, '(i0)') x 65 | end if 66 | else 67 | write(tmp, '(i0)') x 68 | end if 69 | res = trim(tmp) 70 | 71 | end function i4_to_str 72 | 73 | pure function i8_to_str(x) result(res) 74 | 75 | integer(8), intent(in) :: x 76 | character(:), allocatable :: res 77 | 78 | character(range(x)+2) tmp 79 | 80 | write(tmp, '(i0)') x 81 | res = trim(tmp) 82 | 83 | end function i8_to_str 84 | 85 | pure function i4_array_to_str(x) result(res) 86 | 87 | integer(4), intent(in) :: x(:) 88 | character(:), allocatable :: res 89 | 90 | character((range(x)+4) * size(x)) tmp 91 | character(256) fmt 92 | 93 | write(fmt, '("(", I0, "(I0, "", ""))")') size(x) 94 | write(tmp, fmt) x 95 | res = trim(tmp) 96 | 97 | end function i4_array_to_str 98 | 99 | pure function r4_to_str(x, decimal_width, width) result(res) 100 | 101 | real(4), intent(in) :: x 102 | integer, intent(in) :: decimal_width 103 | integer, intent(in), optional :: width 104 | character(:), allocatable :: res 105 | 106 | integer w 107 | character(10) fmt 108 | character(range(x)+2) tmp1, tmp2 109 | 110 | if (present(width)) then 111 | w = max(width, decimal_width + 1 + 6) 112 | write(fmt, "('(G', I0, '.', I0, ')')") w, decimal_width + 1 113 | write(tmp1, fmt) x 114 | else 115 | write(tmp1, "(I0)") int(x) 116 | write(tmp2, "(I0)") abs(int(x * 10**decimal_width) - int(x) * 10**decimal_width) 117 | tmp1 = trim(tmp1) // '.' // trim(adjustl(tmp2)) 118 | end if 119 | res = trim(adjustl(tmp1)) 120 | 121 | end function r4_to_str 122 | 123 | pure function r8_to_str(x, decimal_width, width) result(res) 124 | 125 | real(8), intent(in) :: x 126 | integer, intent(in) :: decimal_width 127 | integer, intent(in), optional :: width 128 | character(:), allocatable :: res 129 | 130 | integer w 131 | character(10) fmt 132 | character(range(x)+2) tmp1, tmp2 133 | 134 | if (present(width)) then 135 | w = max(width, decimal_width + 1 + 6) 136 | write(fmt, "('(G', I0, '.', I0, ')')") w, decimal_width + 1 137 | write(tmp1, fmt) x 138 | else 139 | write(tmp1, "(I0)") int(x) 140 | write(tmp2, "(I0)") abs(int(x * 10**decimal_width) - int(x) * 10**decimal_width) 141 | tmp1 = trim(tmp1) // '.' // trim(adjustl(tmp2)) 142 | end if 143 | res = trim(adjustl(tmp1)) 144 | 145 | end function r8_to_str 146 | 147 | pure function r8_array_to_str(x, decimal_width, width) result(res) 148 | 149 | real(8), intent(in) :: x(:) 150 | integer, intent(in) :: decimal_width 151 | integer, intent(in), optional :: width 152 | character(:), allocatable :: res 153 | 154 | integer w, i, j 155 | character(256) s 156 | character(:), allocatable :: tmp 157 | 158 | if (present(width)) then 159 | w = max(width, decimal_width + 1 + 5) 160 | else 161 | w = decimal_width + 1 + 5 162 | end if 163 | allocate(character(2+(w+1)*size(x)-1)::tmp) 164 | tmp(2:len(tmp)) = '' 165 | tmp(1:1) = '[' 166 | j = 2 167 | do i = 1, size(x) 168 | s = to_str(x(i), decimal_width, width) 169 | tmp(j:j+len_trim(s)-1) = trim(s) 170 | j = j + len_trim(s) 171 | if (i /= size(x)) then 172 | write(tmp(j:j), '(",")') 173 | j = j + 1 174 | end if 175 | end do 176 | tmp(j:j) = ']' 177 | res = trim(tmp) 178 | deallocate(tmp) 179 | 180 | end function r8_array_to_str 181 | 182 | pure function l_to_str(x) result(res) 183 | 184 | logical, intent(in) :: x 185 | character(:), allocatable :: res 186 | 187 | res = trim(merge('true ', 'false', x)) 188 | 189 | end function l_to_str 190 | 191 | pure integer function to_int(x) result(res) 192 | 193 | character(*), intent(in) :: x 194 | 195 | read(x, *) res 196 | 197 | end function to_int 198 | 199 | pure real(4) function to_r4(x) result(res) 200 | 201 | character(*), intent(in) :: x 202 | 203 | read(x, *) res 204 | 205 | end function to_r4 206 | 207 | pure real(8) function to_r8(x) result(res) 208 | 209 | character(*), intent(in) :: x 210 | 211 | read(x, *) res 212 | 213 | end function to_r8 214 | 215 | end module string_numerics_mod 216 | --------------------------------------------------------------------------------