├── CMakeLists.txt ├── LICENSE ├── README.md ├── src ├── CMakeLists.txt └── string_utility_module.f90 └── tests ├── CMakeLists.txt └── tests.f90 /CMakeLists.txt: -------------------------------------------------------------------------------- 1 | cmake_minimum_required ( VERSION 2.8.8 FATAL_ERROR ) 2 | 3 | project( fortran-string-utility-module ) 4 | 5 | # Set CMake language to Fortran 6 | enable_language ( Fortran ) 7 | 8 | # Define object binary directory 9 | set ( BIN_DIR ${CMAKE_BINARY_DIR}/bin ) 10 | set ( LIB_DIR ${CMAKE_BINARY_DIR}/lib ) 11 | 12 | # place executables in the binary root directory 13 | set ( EXECUTABLE_OUTPUT_PATH ${CMAKE_BINARY_DIR} ) 14 | 15 | # Define lib as the module directory 16 | set ( CMAKE_Fortran_MODULE_DIRECTORY ${LIB_DIR} ) 17 | 18 | # Define string utility module source directory 19 | set ( SU_SOURCE_DIR ${CMAKE_SOURCE_DIR}/src ) 20 | set ( SU_SOURCE ${SU_SOURCE_DIR}/string_utility_module.f90 ) 21 | 22 | #set ( BUILD_SU_TESTS TRUE ) 23 | #if ( BUILD_SU_TESTS ) 24 | # Set the name for string utility tests executable 25 | set ( SU_TESTS_EXE su_tests ) 26 | 27 | # Define tests directory 28 | set ( SU_TESTS_SOURCE_DIR ${CMAKE_SOURCE_DIR}/tests ) 29 | add_subdirectory ( ${SU_TESTS_SOURCE_DIR} ${BIN} ) 30 | #endif 31 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015 Thomas E. Dunn 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy of this 4 | software and associated documentation files (the "Software"), to deal in the Software 5 | without restriction, including without limitation the rights to use, copy, modify, merge, 6 | publish, distribute, sublicense, and/or sell copies of the Software, and to permit 7 | persons to whom the Software is furnished to do so, subject to the following conditions: 8 | 9 | The above copyright notice and this permission notice shall be included in all copies or 10 | substantial portions of the Software. 11 | 12 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, 13 | INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR 14 | PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 15 | LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT 16 | OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 17 | DEALINGS IN THE SOFTWARE. 18 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # fortran-string-utility-module 2 | 3 | A collection of functions and subroutines I've found useful for working with 4 | strings (character arrays) in Fortran. 5 | -------------------------------------------------------------------------------- /src/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | # Define tests source files 2 | set ( SU_SRC ${SU_DIR}/string_utility_module.f90 ) 3 | -------------------------------------------------------------------------------- /src/string_utility_module.f90: -------------------------------------------------------------------------------- 1 | !=============================================================================== 2 | module string_utility_module 3 | !=============================================================================== 4 | use, intrinsic :: iso_fortran_env 5 | implicit none 6 | 7 | private 8 | 9 | ! public functions: 10 | public :: str_is_integer 11 | public :: str_is_name 12 | public :: str_is_number 13 | public :: str_is_real 14 | public :: str_loc_next_real 15 | public :: str_lowercase 16 | public :: str_uppercase 17 | 18 | ! public subroutines: 19 | public :: str_convert_to_lowercase 20 | public :: str_convert_to_uppercase 21 | public :: str_loc_next_space 22 | public :: str_loc_next_token 23 | public :: str_loc_next_delimiter 24 | public :: str_parse_next_delimiter 25 | public :: str_parse_next_space 26 | public :: str_parse_next_token 27 | 28 | ! parameters: 29 | integer, parameter :: CK = selected_char_kind('DEFAULT') 30 | !integer, parameter :: LK = logical_kinds(min(3,size(logical_kinds))) 31 | 32 | character(kind=CK,len=*), parameter :: SPACE = ' ' 33 | character(kind=CK,len=*), parameter :: TAB = achar(9) 34 | character(kind=CK,len=*), parameter :: NEWLINE = achar(10) 35 | character(kind=CK,len=*), parameter :: VERTICAL_TAB = achar(11) 36 | character(kind=CK,len=*), parameter :: FORM_FEED = achar(12) 37 | character(kind=CK,len=*), parameter :: CARRIAGE_RETURN = achar(13) 38 | 39 | character(kind=CK,len=*), parameter :: SPACES = SPACE//TAB//NEWLINE & 40 | //VERTICAL_TAB//FORM_FEED//CARRIAGE_RETURN 41 | 42 | character(kind=CK,len=*), parameter :: LETTERS_LC = 'abcdefghijklmnopqrstuvwxyz' 43 | character(kind=CK,len=*), parameter :: LETTERS_UC = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 44 | character(kind=CK,len=*), parameter :: LETTERS = LETTERS_LC//LETTERS_UC 45 | 46 | character(kind=CK,len=*), parameter :: COMMA = ',' 47 | character(kind=CK,len=*), parameter :: SEMICOLON = ';' 48 | character(kind=CK,len=*), parameter :: COLON = ':' 49 | 50 | character(kind=CK,len=*), parameter :: BRACKET_LEFT = '[' 51 | character(kind=CK,len=*), parameter :: BRACKET_RIGHT = ']' 52 | 53 | character(kind=CK,len=*), parameter :: PARENTHESES_LEFT = '(' 54 | character(kind=CK,len=*), parameter :: PARENTHESES_RIGHT = ')' 55 | 56 | character(kind=CK,len=*), parameter :: DELIMITERS = SPACES//COMMA//COLON & 57 | //SEMICOLON//BRACKET_LEFT//BRACKET_RIGHT//PARENTHESES_LEFT//PARENTHESES_RIGHT 58 | 59 | contains 60 | 61 | !=============================================================================== 62 | ! ch_is_digit: 63 | ! 64 | ! Returns .TRUE. if the given character is a digit character. 65 | ! 66 | pure function ch_is_digit( ch ) result( ans ) 67 | character(kind=CK,len=1), intent(in) :: ch 68 | logical :: ans 69 | 70 | select case (ch) 71 | case ('0':'9') 72 | ans = .true. 73 | case default 74 | ans = .false. 75 | end select 76 | end function ch_is_digit 77 | !=============================================================================== 78 | 79 | !=============================================================================== 80 | ! ch_is_letter: 81 | ! 82 | ! Returns .TRUE. if the given character is either a lower case or upper case 83 | ! letter. 84 | ! 85 | pure function ch_is_letter( ch ) result( ans ) 86 | character(kind=CK,len=1), intent(in) :: ch 87 | logical :: ans 88 | 89 | select case (ch) 90 | case ('a':'z','A':'Z') 91 | ans = .true. 92 | case default 93 | ans = .false. 94 | end select 95 | end function ch_is_letter 96 | !=============================================================================== 97 | 98 | !=============================================================================== 99 | ! ch_is_lowercase: 100 | ! 101 | ! Returns .TRUE. if the given character is a lower case letter. 102 | ! 103 | pure function ch_is_lowercase( ch ) result( ans ) 104 | character(kind=CK,len=1), intent(in) :: ch 105 | logical :: ans 106 | 107 | select case (ch) 108 | case ('a':'z') 109 | ans = .true. 110 | case default 111 | ans = .false. 112 | end select 113 | end function ch_is_lowercase 114 | !=============================================================================== 115 | 116 | !=============================================================================== 117 | ! ch_is_space: 118 | ! 119 | ! Returns .TRUE. if the given character is a space character. Either a space, 120 | ! tab, newline, vertical tab, form feed, or carriage return character. 121 | ! 122 | pure function ch_is_space( ch ) result( ans ) 123 | character(kind=CK,len=1), intent(in) :: ch 124 | logical :: ans 125 | 126 | select case (ch) 127 | case (space,tab,newline,vertical_tab,form_feed,carriage_return) 128 | ans = .true. 129 | case default 130 | ans = .false. 131 | end select 132 | end function ch_is_space 133 | !=============================================================================== 134 | 135 | !=============================================================================== 136 | ! ch_is_uppercase: 137 | ! 138 | ! Returns .TRUE. if the given character is an upper case letter. 139 | ! 140 | pure function ch_is_uppercase( ch ) result( ans ) 141 | character(kind=CK,len=1), intent(in) :: ch 142 | logical :: ans 143 | 144 | select case (ch) 145 | case ('A':'Z') 146 | ans = .true. 147 | case default 148 | ans = .false. 149 | end select 150 | end function ch_is_uppercase 151 | !=============================================================================== 152 | 153 | !=============================================================================== 154 | ! ch_convert_to_lowercase: 155 | ! 156 | ! If given an upper case characer, converts it to lower case. 157 | ! 158 | pure subroutine ch_convert_to_lowercase( ch ) 159 | character(kind=CK,len=1), intent(inout) :: ch 160 | ! local variables: 161 | integer :: ic 162 | 163 | ic = ichar(ch) 164 | if (64 < ic .and. ic < 91) ch = char(ic + 32) 165 | end subroutine ch_convert_to_lowercase 166 | !=============================================================================== 167 | 168 | !=============================================================================== 169 | ! ch_convert_to_uppercase: 170 | ! 171 | ! If given a lower case characer, converts it to upper case. 172 | ! 173 | pure subroutine ch_convert_to_uppercase( ch ) 174 | character(kind=CK,len=1), intent(inout) :: ch 175 | ! local variables: 176 | integer :: ic 177 | 178 | ic = ichar(ch) 179 | if (96 < ic .and. ic < 123) ch = char(ic - 32) 180 | end subroutine ch_convert_to_uppercase 181 | !=============================================================================== 182 | 183 | !=============================================================================== 184 | ! str_convert_to_lowercase: 185 | ! 186 | ! Converts upper case characters in the given character string to lower case. 187 | ! 188 | pure subroutine str_convert_to_lowercase( str ) 189 | character(kind=CK,len=*), intent(inout) :: str 190 | ! local variables: 191 | integer :: i 192 | 193 | do i = 1, len_trim(str) 194 | call ch_convert_to_lowercase(str(i:i)) 195 | end do 196 | end subroutine str_convert_to_lowercase 197 | !=============================================================================== 198 | 199 | !=============================================================================== 200 | ! str_convert_to_uppercase: 201 | ! 202 | ! Converts lower case characters in the given character string to upper case. 203 | ! 204 | pure subroutine str_convert_to_uppercase( str ) 205 | character(kind=CK,len=*), intent(inout) :: str 206 | ! local variables: 207 | integer :: i 208 | 209 | do i = 1, len_trim(str) 210 | call ch_convert_to_uppercase(str(i:i)) 211 | end do 212 | end subroutine str_convert_to_uppercase 213 | !=============================================================================== 214 | 215 | !=============================================================================== 216 | ! str_count_tokens: 217 | ! 218 | ! Returns the number of tokens in the given string. 219 | ! 220 | pure function str_count_tokens( str ) result( val ) 221 | character(*), intent(in) :: str 222 | integer :: val 223 | ! local variables: 224 | integer :: pos 225 | integer :: str_len 226 | integer :: i0, i1 227 | 228 | str_len = len_trim(str) 229 | 230 | val = 0 231 | pos = 1 232 | do 233 | if (pos > str_len) then 234 | exit 235 | end if 236 | 237 | ! locate next token 238 | call str_loc_next_token(str, i0, i1, pos) 239 | if (i0 > 0) then 240 | val = val + 1 241 | pos = i1 + 1 242 | else 243 | exit 244 | end if 245 | end do 246 | end function str_count_tokens 247 | !=============================================================================== 248 | 249 | !=============================================================================== 250 | ! str_get_next_character: 251 | ! 252 | ! Gets the next non-whitespace character from the given string. If no such 253 | ! characters are found then a space is returned. 254 | ! 255 | pure subroutine str_get_next_character( str, ch, ich ) 256 | character(kind=CK,len=*), intent(in) :: str 257 | character(kind=CK,len=1), intent(out) :: ch 258 | integer, intent(inout), optional :: ich 259 | ! local variables: 260 | integer :: i 261 | integer :: i0 262 | 263 | if (present(ich)) then 264 | i0 = ich 265 | else 266 | i0 = 1 267 | end if 268 | 269 | ch = ' ' 270 | do i = i0, len_trim(str) 271 | select case (str(i:i)) 272 | case (space,tab) 273 | continue 274 | case default 275 | ch = str(i:i) 276 | exit 277 | end select 278 | end do 279 | 280 | if (present(ich)) ich = i 281 | end subroutine str_get_next_character 282 | !=============================================================================== 283 | 284 | !=============================================================================== 285 | ! str_is_integer: 286 | ! 287 | ! Returns .TRUE. if the given string contains an integer value. Returns 288 | ! .FALSE. otherwise. 289 | ! 290 | ! ans |F |F |T |F |F |T |T| 291 | ! stage |0 |1 |2 |3 |4 |5 |6| 292 | ! regex | [\+\-]? \d+ ([eE] \+? \d+)? | 293 | ! 294 | function str_is_integer( str, allow_spaces ) result( ans ) 295 | character(kind=CK,len=*), intent(in) :: str 296 | logical, intent(in), optional :: allow_spaces 297 | logical :: ans 298 | ! local variables: 299 | integer :: i 300 | logical :: no_spaces 301 | logical :: not_integer 302 | integer :: stage 303 | 304 | if (present(allow_spaces)) then 305 | no_spaces = .not.allow_spaces 306 | else 307 | no_spaces = .false. 308 | end if 309 | 310 | ! determine number type and length 311 | stage = 0 312 | not_integer = .false. 313 | do i = 1, len(str) 314 | select case(str(i:i)) 315 | case (space,tab) 316 | ! white space 317 | select case (stage) 318 | case (0,6) 319 | not_integer = no_spaces 320 | case (2,5) 321 | not_integer = no_spaces 322 | stage = 6 323 | case default 324 | not_integer = .true. 325 | end select 326 | case ('-') 327 | ! minus sign 328 | select case(stage) 329 | case(0) 330 | stage = 1 331 | case default 332 | not_integer = .true. 333 | end select 334 | case ('+') 335 | ! plus sign 336 | select case(stage) 337 | case(0) 338 | stage = 1 339 | case(3) 340 | stage = 4 341 | case default 342 | not_integer = .true. 343 | end select 344 | case ('0':'9') 345 | ! digit 346 | select case(stage) 347 | case(0:1) 348 | stage = 2 349 | case(3:4) 350 | stage = 5 351 | case default 352 | continue 353 | end select 354 | case ('e','E') 355 | ! exponent 356 | select case(stage) 357 | case(2) 358 | stage = 3 359 | case default 360 | not_integer = .true. 361 | end select 362 | case default 363 | not_integer = .true. 364 | end select 365 | 366 | if (not_integer) exit 367 | end do 368 | 369 | ! determine if integer 370 | if (not_integer) then 371 | ans = .false. 372 | else 373 | select case (stage) 374 | case (2,5,6) 375 | ans = .true. 376 | case default 377 | ans = .false. 378 | end select 379 | end if 380 | end function str_is_integer 381 | !=============================================================================== 382 | 383 | !=============================================================================== 384 | ! str_is_name: 385 | ! 386 | ! Returns .TRUE. if the given string contains a name. Returns .FALSE. 387 | ! otherwise. 388 | ! 389 | ! ans |F |T |T |T| 390 | ! stage |0 |1 |2 |3| 391 | ! regex | \w [\w\_\d]* | 392 | ! 393 | function str_is_name( str, allow_spaces ) result( ans ) 394 | character(kind=CK,len=*), intent(in) :: str 395 | logical, intent(in), optional :: allow_spaces 396 | logical :: ans 397 | ! local variables: 398 | integer :: i 399 | logical :: no_spaces 400 | logical :: not_name 401 | integer :: stage 402 | 403 | if (present(allow_spaces)) then 404 | no_spaces = .not.allow_spaces 405 | else 406 | no_spaces = .false. 407 | end if 408 | 409 | ! determine number type and length 410 | stage = 0 411 | not_name = .false. 412 | do i = 1, len(str) 413 | select case(str(i:i)) 414 | case (space,tab) 415 | ! white space 416 | select case (stage) 417 | case (0,3) 418 | not_name = no_spaces 419 | case (1,2) 420 | not_name = no_spaces 421 | stage = 3 422 | end select 423 | case ('a':'z','A':'Z') 424 | ! character 425 | select case(stage) 426 | case(0) 427 | stage = 1 428 | case(1:2) 429 | continue 430 | case default 431 | not_name = .true. 432 | end select 433 | case ('0':'9','_') 434 | ! digit or underscore 435 | select case(stage) 436 | case(1) 437 | stage = 2 438 | case(2) 439 | continue 440 | case default 441 | not_name = .true. 442 | end select 443 | case default 444 | not_name = .true. 445 | end select 446 | 447 | if (not_name) exit 448 | end do 449 | 450 | ! determine if name 451 | if (not_name) then 452 | ans = .false. 453 | else 454 | select case (stage) 455 | case (1:3) 456 | ans = .true. 457 | case default 458 | ans = .false. 459 | end select 460 | end if 461 | end function str_is_name 462 | !=============================================================================== 463 | 464 | !=============================================================================== 465 | ! str_is_number: 466 | ! 467 | ! Returns .TRUE. if the given string contains a real value. Returns .FALSE. 468 | ! otherwise. 469 | ! type |~ |Integer |Real | | 470 | ! ans |F |F |T |F |F |T |T |T |T |F |F |T | | 471 | ! stage |0 |1 |11 |12 |13 |14 |21 |22 |23 |24 |25 |26 | | 472 | ! regex | [\+\-]? (\d+ ([eE] \+? \d+)? |\d* \.? \d* ([deDE] [\+\-]? \d+)?) | 473 | ! 474 | pure function str_is_number( str, allow_spaces ) result( ans ) 475 | character(kind=CK,len=*), intent(in) :: str 476 | logical, intent(in), optional :: allow_spaces 477 | logical :: ans 478 | ! local variables: 479 | integer :: i 480 | logical :: has_leading_digit 481 | logical :: no_spaces 482 | integer :: stage, stage_final 483 | integer :: str_len 484 | character(kind=CK,len=:), allocatable :: num_type 485 | 486 | if (present(allow_spaces)) then 487 | no_spaces = .not.allow_spaces 488 | else 489 | no_spaces = .false. 490 | end if 491 | 492 | ! determine number type and length 493 | str_len = len(str) 494 | stage = 0 495 | stage_final = 0 496 | has_leading_digit = .false. 497 | do i = 1, str_len 498 | select case(stage) 499 | case (0) ! leading space 500 | select case(str(i:i)) 501 | case (SPACE,TAB) 502 | if (no_spaces) then 503 | stage = -1 504 | else 505 | stage = 0 506 | end if 507 | case ('+','-') 508 | stage = 1 509 | case ('0':'9') 510 | stage = 11 511 | case default 512 | stage = -1 513 | end select 514 | case (1) ! leading sign 515 | select case(str(i:i)) 516 | case ('0':'9') 517 | stage = 11 518 | has_leading_digit = .true. 519 | case ('.') 520 | stage = 22 521 | case default 522 | stage = -1 523 | end select 524 | case (11) ! leading digit 525 | select case(str(i:i)) 526 | case ('0':'9') 527 | stage = 11 528 | case ('e','E') 529 | stage = 12 530 | case ('.') 531 | stage = 22 532 | case ('d','D') 533 | stage = 24 534 | case (SPACE,TAB) 535 | if (no_spaces) then 536 | stage = -1 537 | else 538 | stage_final = stage 539 | stage = 30 540 | end if 541 | case default 542 | stage = -1 543 | end select 544 | case (12) ! integer exponent 545 | select case(str(i:i)) 546 | case ('+') 547 | stage = 13 548 | case ('0':'9') 549 | stage = 14 550 | case ('-') 551 | stage = 25 552 | case default 553 | stage = -1 554 | end select 555 | case (13) ! integer exponent sign 556 | select case(str(i:i)) 557 | case ('0':'9') 558 | stage = 14 559 | case default 560 | stage = -1 561 | end select 562 | case (14) ! integer exponent number 563 | select case(str(i:i)) 564 | case ('0':'9') 565 | stage = 14 566 | case (SPACE,TAB) 567 | if (no_spaces) then 568 | stage = -1 569 | else 570 | stage_final = stage 571 | stage = 30 572 | end if 573 | case default 574 | stage = -1 575 | end select 576 | case (22) ! real decimal point 577 | select case(str(i:i)) 578 | case ('0':'9') 579 | stage = 23 580 | case ('d','e','D','E') 581 | if (has_leading_digit) then 582 | stage = 24 583 | else 584 | stage = -1 585 | end if 586 | case (SPACE,TAB) 587 | if (has_leading_digit) then 588 | if (no_spaces) then 589 | stage = -1 590 | else 591 | stage_final = stage 592 | stage = 30 593 | end if 594 | else 595 | stage = -1 596 | end if 597 | case default 598 | stage = -1 599 | end select 600 | case (23) ! real decimal number 601 | select case(str(i:i)) 602 | case ('0':'9') 603 | stage = 23 604 | case ('d','e','D','E') 605 | stage = 24 606 | case (SPACE,TAB) 607 | if (no_spaces) then 608 | stage = -1 609 | else 610 | stage_final = stage 611 | stage = 30 612 | end if 613 | case default 614 | stage = -1 615 | end select 616 | case (24) ! real exponent 617 | select case(str(i:i)) 618 | case ('0':'9') 619 | stage = 26 620 | case ('+','-') 621 | stage = 25 622 | case default 623 | stage = -1 624 | end select 625 | case (25) ! real exponent sign 626 | select case(str(i:i)) 627 | case ('0':'9') 628 | stage = 26 629 | case default 630 | stage = -1 631 | end select 632 | case (26) ! real exponent sign 633 | select case(str(i:i)) 634 | case ('0':'9') 635 | stage = 26 636 | case (SPACE,TAB) 637 | if (no_spaces) then 638 | stage = -1 639 | else 640 | stage_final = stage 641 | stage = 30 642 | end if 643 | case default 644 | stage = -1 645 | end select 646 | case (30) ! trailing white space 647 | select case(str(i:i)) 648 | case (SPACE,TAB) 649 | stage = 30 650 | case default 651 | stage = -1 652 | end select 653 | end select 654 | 655 | if (stage == -1) exit 656 | end do 657 | 658 | if (i > str_len) then 659 | stage_final = stage 660 | end if 661 | 662 | ! determine result and number type 663 | if (stage == -1) then 664 | ans = .false. 665 | num_type = '' 666 | else 667 | select case(stage_final) 668 | case (11,14) 669 | ans = .true. 670 | num_type = 'INTEGER' 671 | case (22) 672 | if (has_leading_digit) then 673 | ans = .true. 674 | num_type = 'REAL' 675 | else 676 | ans = .false. 677 | end if 678 | case (23,26) 679 | ans = .true. 680 | num_type = 'REAL' 681 | end select 682 | end if 683 | end function str_is_number 684 | !=============================================================================== 685 | 686 | !=============================================================================== 687 | ! str_is_real: 688 | ! 689 | ! Returns .TRUE. if the given string contains a real value. Returns .FALSE. 690 | ! otherwise. 691 | ! ans |F |F |T |T |T |F |F |T |T | 692 | ! stage |0 |1 |2 |3 |4 |5 |6 |7 |8 | 693 | ! regex | [\+\-]? \d* ( |\.? \d* ([deDE] [\+\-]? \d+)?) | 694 | ! 695 | pure function str_is_real( str, allow_spaces ) result( ans ) 696 | character(kind=CK,len=*), intent(in) :: str 697 | logical, intent(in), optional :: allow_spaces 698 | logical :: ans 699 | ! local variables: 700 | integer :: i 701 | logical :: has_leading_digit 702 | logical :: no_spaces 703 | logical :: not_real 704 | integer :: stage 705 | 706 | if (present(allow_spaces)) then 707 | no_spaces = .not.allow_spaces 708 | else 709 | no_spaces = .false. 710 | end if 711 | 712 | ! determine number type and length 713 | stage = 0 714 | not_real = .false. 715 | has_leading_digit = .false. 716 | do i = 1, len(str) 717 | select case(str(i:i)) 718 | case (SPACE,TAB) 719 | ! white space 720 | select case (stage) 721 | case (0,8) 722 | not_real = no_spaces 723 | continue 724 | case (2:4,7) 725 | not_real = no_spaces 726 | stage = 8 727 | case default 728 | not_real = .true. 729 | end select 730 | case ('+','-') 731 | select case(stage) 732 | case(0) 733 | stage = 1 734 | case(5) 735 | stage = 6 736 | case default 737 | not_real = .true. 738 | end select 739 | case ('0':'9') 740 | select case(stage) 741 | case(0:1) 742 | stage = 2 743 | has_leading_digit = .true. 744 | case(3) 745 | stage = 4 746 | case(5:6) 747 | stage = 7 748 | case default 749 | continue 750 | end select 751 | case ('.') 752 | select case(stage) 753 | case(0:2) 754 | stage = 3 755 | case default 756 | not_real = .true. 757 | end select 758 | case ('e','E','d','D') 759 | select case(stage) 760 | case(2:4) 761 | stage = 5 762 | case default 763 | not_real = .true. 764 | end select 765 | case default 766 | not_real = .true. 767 | end select 768 | 769 | if (not_real) exit 770 | end do 771 | 772 | ! determine if real 773 | if (not_real) then 774 | ans = .false. 775 | else 776 | select case (stage) 777 | case (2,4,7,8) 778 | ans = .true. 779 | case (3) 780 | ans = has_leading_digit 781 | case default 782 | ans = .false. 783 | end select 784 | end if 785 | end function str_is_real 786 | !=============================================================================== 787 | 788 | !=============================================================================== 789 | ! str_loc_end_delimeter: 790 | ! 791 | ! Returns the location of the last delimiter from the start of the given 792 | ! string (first non-delimiter character position -1). Returns 0 if no 793 | ! delimiter characters are found. 794 | ! 795 | pure function str_loc_end_delimiter( str, start ) result( val ) 796 | character(kind=CK,len=*), intent(in) :: str 797 | integer, intent(in), optional :: start 798 | integer :: val 799 | ! local variables: 800 | integer :: i 801 | 802 | if (present(start)) then 803 | i = start 804 | else 805 | i = 1 806 | end if 807 | 808 | val = verify(str(i:), DELIMITERS) 809 | if (val == 0) then 810 | val = len(str) 811 | else 812 | val = val + i - 2 813 | end if 814 | end function str_loc_end_delimiter 815 | !=============================================================================== 816 | 817 | !=============================================================================== 818 | ! str_loc_end_space: 819 | ! 820 | ! Returns the location of the last delimiter from the start of the given 821 | ! string (first non-delimiter character position -1). Returns 0 if no 822 | ! delimiter characters are found. 823 | ! 824 | pure function str_loc_end_space( str, start ) result( val ) 825 | character(kind=CK,len=*), intent(in) :: str 826 | integer, intent(in), optional :: start 827 | integer :: val 828 | ! local variables: 829 | integer :: i 830 | 831 | if (present(start)) then 832 | i = start 833 | else 834 | i = 1 835 | end if 836 | 837 | val = verify(str(i:), SPACES) 838 | if (val == 0) then 839 | val = len(str) 840 | else 841 | val = val + i - 2 842 | end if 843 | end function str_loc_end_space 844 | !=============================================================================== 845 | 846 | !=============================================================================== 847 | ! str_loc_end_token: 848 | ! 849 | ! Returns the location of the last valid token character starting from the 850 | ! begining of the string. Returns 0 if no valid token characters were found. 851 | ! 852 | pure function str_loc_end_token( str, start ) result( val ) 853 | character(kind=CK,len=*), intent(in) :: str 854 | integer, intent(in), optional :: start 855 | integer :: val 856 | ! local variables: 857 | integer :: i 858 | 859 | if (present(start)) then 860 | i = start 861 | else 862 | i = 1 863 | end if 864 | 865 | val = scan(str(i:), DELIMITERS) 866 | if (val == 0) then 867 | val = len(str) 868 | else 869 | val = val + i - 2 870 | end if 871 | end function str_loc_end_token 872 | !=============================================================================== 873 | 874 | !=============================================================================== 875 | ! str_loc_next_letter: 876 | ! 877 | ! Returns the location of the first letter in the given string. Returns 0 if 878 | ! no letter is found. 879 | ! 880 | pure function str_loc_next_letter( str ) result( val ) 881 | character(kind=CK,len=*), intent(in) :: str 882 | integer :: val 883 | 884 | val = scan(str, LETTERS) 885 | end function str_loc_next_letter 886 | !=============================================================================== 887 | 888 | !=============================================================================== 889 | ! str_loc_next_real: 890 | ! 891 | ! Returns .TRUE. if the given string contains a real value. Returns .FALSE. 892 | ! otherwise. 893 | ! ans |F |F |T |T |T |F |F |T |T| 894 | ! stage |0 |1 |2 |3 |4 |5 |6 |7 |8| 895 | ! regex | [\+\-]? \d* (\.? \d* ([deDE] [\+\-]? \d+)?) | 896 | ! 897 | pure function str_loc_next_real( str ) result( loc ) 898 | character(kind=CK,len=*), intent(in) :: str 899 | integer :: loc 900 | ! local variables: 901 | integer :: i, i0 902 | logical :: has_leading_digit 903 | integer :: stage 904 | 905 | 906 | ! determine number type and length 907 | stage = 0 908 | has_leading_digit = .false. 909 | do i = 1, len(str) 910 | if (stage == 0) i0 = i 911 | 912 | select case(str(i:i)) 913 | case (SPACE,TAB,NEWLINE,CARRIAGE_RETURN,';',':',',','{','}','(',')','[',']') 914 | select case(stage) 915 | case(-1) 916 | stage = 0 917 | case (2:4,7) 918 | stage = 8 919 | end select 920 | case ('+','-') 921 | select case(stage) 922 | case(0) 923 | stage = 1 924 | case(5) 925 | stage = 6 926 | case default 927 | stage = -1 928 | end select 929 | case ('0':'9') 930 | select case(stage) 931 | case(0:1) 932 | stage = 2 933 | has_leading_digit = .true. 934 | case(3) 935 | stage = 4 936 | case(5:6) 937 | stage = 7 938 | case default 939 | continue 940 | end select 941 | case ('.') 942 | select case(stage) 943 | case(0:2) 944 | stage = 3 945 | case default 946 | stage = -1 947 | end select 948 | case ('e','E','d','D') 949 | select case(stage) 950 | case(2,4) 951 | stage = 5 952 | case (3) 953 | if (has_leading_digit) then 954 | stage = 5 955 | else 956 | stage = -1 957 | end if 958 | case default 959 | stage = -1 960 | end select 961 | case default 962 | stage = -1 963 | end select 964 | 965 | if (stage == 8) exit 966 | if (stage == -1) has_leading_digit = .false. 967 | end do 968 | 969 | loc = 0 970 | select case(stage) 971 | case (2,4,7,8) 972 | loc = i0 973 | case (3) 974 | if (has_leading_digit) loc = i0 975 | end select 976 | end function str_loc_next_real 977 | !=============================================================================== 978 | 979 | !=============================================================================== 980 | ! str_loc_next_delimiter: 981 | ! 982 | ! Returns the location of the start and end of the next delimiter substring. 983 | ! Returns 0 if no delimiter is found. 984 | ! 985 | pure subroutine str_loc_next_delimiter( str, i0, i1, start ) 986 | character(kind=CK,len=*), intent(in) :: str 987 | integer, intent(inout) :: i0 988 | integer, intent(inout) :: i1 989 | integer, intent(in), optional :: start 990 | ! local variables: 991 | integer :: i 992 | 993 | if (present(start)) then 994 | i = start 995 | else 996 | i = 1 997 | end if 998 | 999 | i0 = str_loc_start_delimiter(str, i) 1000 | if (i0 == 0) then 1001 | i1 = 0 1002 | else 1003 | i1 = str_loc_end_delimiter(str, i0) 1004 | end if 1005 | end subroutine str_loc_next_delimiter 1006 | !=============================================================================== 1007 | 1008 | !=============================================================================== 1009 | ! str_loc_next_space: 1010 | ! 1011 | ! Returns the location of the start and end of the next space substring. 1012 | ! Returns 0 if no space is found. 1013 | ! 1014 | pure subroutine str_loc_next_space( str, i0, i1, start ) 1015 | character(kind=CK,len=*), intent(in) :: str 1016 | integer, intent(inout) :: i0 1017 | integer, intent(inout) :: i1 1018 | integer, intent(in), optional :: start 1019 | ! local variables: 1020 | integer :: i 1021 | 1022 | if (present(start)) then 1023 | i = start 1024 | else 1025 | i = 1 1026 | end if 1027 | 1028 | i0 = str_loc_start_space(str, i) 1029 | if (i0 == 0) then 1030 | i1 = 0 1031 | else 1032 | i1 = str_loc_end_space(str, i0) 1033 | end if 1034 | end subroutine str_loc_next_space 1035 | !=============================================================================== 1036 | 1037 | !=============================================================================== 1038 | ! str_loc_next_token: 1039 | ! 1040 | ! Returns the location of the start and end of the next token substring. 1041 | ! Returns 0 if no token is found. 1042 | ! 1043 | pure subroutine str_loc_next_token( str, i0, i1, start ) 1044 | character(kind=CK,len=*), intent(in) :: str 1045 | integer, intent(inout) :: i0 1046 | integer, intent(inout) :: i1 1047 | integer, intent(in), optional :: start 1048 | ! local variables: 1049 | integer :: i 1050 | 1051 | if (present(start)) then 1052 | i = start 1053 | else 1054 | i = 1 1055 | end if 1056 | 1057 | i0 = str_loc_start_token(str, i) 1058 | if (i0 == 0) then 1059 | i1 = 0 1060 | else 1061 | i1 = str_loc_end_token(str, i0) 1062 | end if 1063 | end subroutine str_loc_next_token 1064 | !=============================================================================== 1065 | 1066 | !=============================================================================== 1067 | ! str_loc_start_delimiter: 1068 | ! 1069 | ! Returns the location of the first delimiter character. Returns 0 if no 1070 | ! delimiter characters are found. 1071 | ! 1072 | pure function str_loc_start_delimiter( str, start ) result( val ) 1073 | character(kind=CK,len=*), intent(in) :: str 1074 | integer, intent(in), optional :: start 1075 | integer :: val 1076 | ! local variables: 1077 | integer :: i 1078 | 1079 | if (present(start)) then 1080 | i = start 1081 | else 1082 | i = 1 1083 | end if 1084 | 1085 | val = scan(str(i:), DELIMITERS) 1086 | if (val > 0) val = val + i - 1 1087 | end function str_loc_start_delimiter 1088 | !=============================================================================== 1089 | 1090 | !=============================================================================== 1091 | ! str_loc_start_space: 1092 | ! 1093 | ! Returns the location of the first space in the given string. Returns 0 if no 1094 | ! space is found. 1095 | ! 1096 | pure function str_loc_start_space( str, start ) result( val ) 1097 | character(kind=CK,len=*), intent(in) :: str 1098 | integer, intent(in), optional :: start 1099 | integer :: val 1100 | ! local variables: 1101 | integer :: i 1102 | 1103 | if (present(start)) then 1104 | i = start 1105 | else 1106 | i = 1 1107 | end if 1108 | 1109 | val = scan(str(i:), SPACES) 1110 | if (val > 0) val = val + i - 1 1111 | end function str_loc_start_space 1112 | !=============================================================================== 1113 | 1114 | !=============================================================================== 1115 | ! str_loc_start_token: 1116 | ! 1117 | ! Returns the location of the first valid token character. Returns 0 if no 1118 | ! valid token characters are found. 1119 | ! 1120 | pure function str_loc_start_token( str, start ) result( val ) 1121 | character(kind=CK,len=*), intent(in) :: str 1122 | integer, intent(in), optional :: start 1123 | integer :: val 1124 | ! local variables: 1125 | integer :: i 1126 | 1127 | if (present(start)) then 1128 | i = start 1129 | else 1130 | i = 1 1131 | end if 1132 | 1133 | ! find the first non-delimiter character 1134 | val = verify(str(i:), DELIMITERS) 1135 | if (val > 0) val = val + i - 1 1136 | end function str_loc_start_token 1137 | !=============================================================================== 1138 | 1139 | !=============================================================================== 1140 | ! str_lowercase: 1141 | ! 1142 | ! Returns given string with all characters A-Z converted to lower case. 1143 | ! 1144 | pure function str_lowercase( str ) result( lstr ) 1145 | character(kind=CK,len=*), intent(in) :: str 1146 | character(:), allocatable :: lstr 1147 | lstr = str 1148 | call str_convert_to_lowercase(lstr) 1149 | end function str_lowercase 1150 | !=============================================================================== 1151 | 1152 | !=============================================================================== 1153 | ! str_parse_next_delimiter: 1154 | ! 1155 | ! Searches through the given string, starting from location i, and returns the 1156 | ! first delimiter substring found. The value of is then set to the string 1157 | ! location just after the end of the returned substring. If no such substring 1158 | ! is found the value of i is set the length of the given string. 1159 | ! 1160 | pure subroutine str_parse_next_delimiter( str, i, delimiter ) 1161 | character(kind=CK,len=*), intent(in) :: str 1162 | integer, intent(inout) :: i 1163 | character(kind=CK,len=:), allocatable, intent(out) :: delimiter 1164 | ! local characters: 1165 | integer :: i0, i1 1166 | 1167 | call str_loc_next_delimiter(str, i0, i1, start=i) 1168 | if (i0 == 0) then 1169 | delimiter = '' 1170 | i = len_trim(str) 1171 | else 1172 | delimiter = str(i0:i1) 1173 | i = i1 + 1 1174 | end if 1175 | end subroutine str_parse_next_delimiter 1176 | !=============================================================================== 1177 | 1178 | !=============================================================================== 1179 | ! str_parse_next_space: 1180 | ! 1181 | ! Searches through the given string, starting from location i, and returns the 1182 | ! first space substring found. The value of is then set to the string location 1183 | ! just after the end of the returned substring. If no such substring is found 1184 | ! the value of i is set the length of the given string. 1185 | ! 1186 | pure subroutine str_parse_next_space( str, i, sp ) 1187 | character(kind=CK,len=*), intent(in) :: str 1188 | integer, intent(inout) :: i 1189 | character(kind=CK,len=:), allocatable, intent(out) :: sp 1190 | ! local characters: 1191 | integer :: i0, i1 1192 | 1193 | call str_loc_next_space(str, i0, i1, start=i) 1194 | if (i0 == 0) then 1195 | sp = '' 1196 | i = len_trim(str) 1197 | else 1198 | sp = str(i0:i1) 1199 | i = i1 + 1 1200 | end if 1201 | end subroutine str_parse_next_space 1202 | !=============================================================================== 1203 | 1204 | !=============================================================================== 1205 | ! str_parse_next_token: 1206 | ! 1207 | ! Searches through the given string, starting from location i, and returns the 1208 | ! first token substring found. The value of is then set to the string location 1209 | ! just after the end of the returned substring. If no such substring is found 1210 | ! the value of i is set the length of the given string. 1211 | ! 1212 | pure subroutine str_parse_next_token( str, i, token ) 1213 | character(kind=CK,len=*), intent(in) :: str 1214 | integer, intent(inout) :: i 1215 | character(kind=CK,len=:), allocatable, intent(out) :: token 1216 | ! local characters: 1217 | integer :: i0, i1 1218 | 1219 | call str_loc_next_token(str, i0, i1, start=i) 1220 | if (i0 == 0) then 1221 | token = '' 1222 | i = len_trim(str) 1223 | else 1224 | token = str(i0:i1) 1225 | i = i1 + 1 1226 | end if 1227 | end subroutine str_parse_next_token 1228 | !=============================================================================== 1229 | 1230 | !=============================================================================== 1231 | ! str_uppercase: 1232 | ! 1233 | ! Returns given string with all characters a-z converted to upper case. 1234 | ! 1235 | pure function str_uppercase( str ) result( ustr ) 1236 | character(kind=CK,len=*), intent(in) :: str 1237 | character(:), allocatable :: ustr 1238 | ustr = str 1239 | call str_convert_to_uppercase(ustr) 1240 | end function str_uppercase 1241 | !=============================================================================== 1242 | end module string_utility_module 1243 | !=============================================================================== 1244 | -------------------------------------------------------------------------------- /tests/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | # Define tests source files 2 | set ( SU_TESTS_SOURCE 3 | ${SU_TESTS_SOURCE_DIR}/tests.f90 4 | ${SU_SOURCE} 5 | ) 6 | 7 | # Define tests executable 8 | add_executable ( ${SU_TESTS_EXE} ${SU_TESTS_SOURCE} ) 9 | -------------------------------------------------------------------------------- /tests/tests.f90: -------------------------------------------------------------------------------- 1 | !=============================================================================== 2 | program main 3 | !=============================================================================== 4 | use string_utility_module 5 | implicit none 6 | ! local variables: 7 | character(:), allocatable :: str 8 | logical, allocatable :: results(:) 9 | 10 | 11 | write(*,'("subroutine STR_CONVERT_TO_LOWERCASE:")') 12 | call TEST_str_convert_to_lowercase(results) 13 | write(*,'(" passed ",I0,"/",I0," tests.")') count(results), size(results) 14 | 15 | 16 | write(*,'("subroutine STR_CONVERT_TO_UPPERCASE:")') 17 | call TEST_str_convert_to_uppercase(results) 18 | write(*,'(" passed ",I0,"/",I0," tests.")') count(results), size(results) 19 | 20 | 21 | write(*,'("function STR_IS_INTEGER:")') 22 | call TEST_str_is_integer(results) 23 | write(*,'(" passed ",I0,"/",I0," tests.")') count(results), size(results) 24 | 25 | 26 | write(*,'("function STR_IS_NAME:")') 27 | call TEST_str_is_name(results) 28 | write(*,'(" passed ",I0,"/",I0," tests.")') count(results), size(results) 29 | 30 | 31 | write(*,'("function STR_IS_NUMBER:")') 32 | call TEST_str_is_number(results) 33 | write(*,'(" passed ",I0,"/",I0," tests.")') count(results), size(results) 34 | 35 | 36 | write(*,'("function STR_IS_REAL:")') 37 | call TEST_str_is_real(results) 38 | write(*,'(" passed ",I0,"/",I0," tests.")') count(results), size(results) 39 | 40 | 41 | write(*,'("function STR_LOC_NEXT_REAL:")') 42 | call TEST_str_loc_next_real(results) 43 | write(*,'(" passed ",I0,"/",I0," tests.")') count(results), size(results) 44 | 45 | 46 | write(*,'("subroutine STR_PARSE_NEXT_DELIMITER:")') 47 | call TEST_str_parse_next_delimiter(results) 48 | write(*,'(" passed ",I0,"/",I0," tests.")') count(results), size(results) 49 | 50 | 51 | write(*,'("subroutine STR_PARSE_NEXT_SPACE:")') 52 | call TEST_str_parse_next_space(results) 53 | write(*,'(" passed ",I0,"/",I0," tests.")') count(results), size(results) 54 | 55 | 56 | write(*,'("subroutine STR_PARSE_NEXT_TOKEN:")') 57 | call TEST_str_parse_next_token(results) 58 | write(*,'(" passed ",I0,"/",I0," tests.")') count(results), size(results) 59 | 60 | contains 61 | 62 | !=============================================================================== 63 | ! TEST_str_convert_to_lowercase: 64 | ! 65 | subroutine TEST_str_convert_to_lowercase( results ) 66 | logical, allocatable, intent(out) :: results(:) 67 | ! local parameters: 68 | integer, parameter :: nTests = 1 69 | character(len=*), parameter :: str_lo = 'abcdefghijklmnopqrstuvwxyz' 70 | character(len=*), parameter :: str_up = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 71 | ! local variables: 72 | character(:), allocatable :: str 73 | 74 | allocate(results(nTests)) 75 | 76 | str = str_up 77 | call str_convert_to_lowercase(str) 78 | results(1) = str == str_lo 79 | end subroutine TEST_str_convert_to_lowercase 80 | !=============================================================================== 81 | 82 | !=============================================================================== 83 | ! TEST_str_convert_to_uppercase: 84 | ! 85 | subroutine TEST_str_convert_to_uppercase( results ) 86 | logical, allocatable, intent(out) :: results(:) 87 | ! local parameters: 88 | integer, parameter :: nTests = 1 89 | character(len=*), parameter :: str_lo = 'abcdefghijklmnopqrstuvwxyz' 90 | character(len=*), parameter :: str_up = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 91 | ! local variables: 92 | character(:), allocatable :: str 93 | 94 | allocate(results(nTests)) 95 | 96 | str = str_lo 97 | call str_convert_to_uppercase(str) 98 | results(1) = str == str_up 99 | end subroutine TEST_str_convert_to_uppercase 100 | !=============================================================================== 101 | 102 | !=============================================================================== 103 | ! TEST_str_is_integer: 104 | ! 105 | subroutine TEST_str_is_integer( results ) 106 | logical, allocatable, intent(out) :: results(:) 107 | ! local parameters: 108 | integer, parameter :: nTests = 4 109 | 110 | allocate(results(nTests)) 111 | 112 | results(1) = str_is_integer(' 1 ') 113 | results(2) = str_is_integer(' +1 ') 114 | results(3) = str_is_integer(' +1e0 ') 115 | results(4) = str_is_integer(' +1e+0 ') 116 | end subroutine TEST_str_is_integer 117 | !=============================================================================== 118 | 119 | !=============================================================================== 120 | ! TEST_str_is_name: 121 | ! 122 | subroutine TEST_str_is_name( results ) 123 | logical, allocatable, intent(out) :: results(:) 124 | ! local parameters: 125 | integer, parameter :: nTests = 12 126 | 127 | allocate(results(nTests)) 128 | 129 | results(01) = str_is_name(' n ') 130 | results(02) = str_is_name(' name ') 131 | results(03) = str_is_name(' name_ ') 132 | results(04) = str_is_name(' name_1 ') 133 | results(05) = str_is_name(' name_one ') 134 | results(06) = str_is_name(' name1 ') 135 | results(07) = str_is_name(' name1_ ') 136 | 137 | results(08) = .not.str_is_name(' _ ') 138 | results(09) = .not.str_is_name(' _name ') 139 | results(10) = .not.str_is_name(' 1 ') 140 | results(11) = .not.str_is_name(' 1name ') 141 | results(12) = .not.str_is_name(' name 1 ') 142 | end subroutine TEST_str_is_name 143 | !=============================================================================== 144 | 145 | !=============================================================================== 146 | ! TEST_str_is_number: 147 | ! 148 | subroutine TEST_str_is_number( results ) 149 | logical, allocatable, intent(out) :: results(:) 150 | ! local parameters: 151 | integer, parameter :: nTests = 12 152 | 153 | allocate(results(nTests)) 154 | 155 | results(01) = str_is_number(' 1 ') 156 | results(02) = str_is_number(' +1 ') 157 | results(03) = str_is_number(' +1e0 ') 158 | results(04) = str_is_number(' +1e+0 ') 159 | results(05) = str_is_number(' +1. ') 160 | results(06) = str_is_number(' +1.0 ') 161 | results(07) = str_is_number(' +1.d0 ') 162 | results(08) = str_is_number(' +1.0d0 ') 163 | results(09) = str_is_number(' +1.0d+0 ') 164 | results(10) = str_is_number(' +1.0d+0 ') 165 | 166 | results(11) = .not.str_is_number(' - ') 167 | results(12) = .not.str_is_number(' .d+00 ') 168 | end subroutine TEST_str_is_number 169 | !=============================================================================== 170 | 171 | !=============================================================================== 172 | ! TEST_str_is_real: 173 | ! 174 | subroutine TEST_str_is_real( results ) 175 | logical, allocatable, intent(out) :: results(:) 176 | ! local parameters: 177 | integer, parameter :: nTests = 8 178 | 179 | allocate(results(nTests)) 180 | 181 | results(1) = str_is_real(' 1 ') 182 | results(2) = str_is_real(' +1 ') 183 | results(3) = str_is_real(' +1. ') 184 | results(4) = str_is_real(' +1.0 ') 185 | results(5) = str_is_real(' +1.d0 ') 186 | results(6) = str_is_real(' +1.0d0 ') 187 | results(7) = str_is_real(' +1.0d+0 ') 188 | results(8) = str_is_real(' +1.0d+0 ') 189 | end subroutine TEST_str_is_real 190 | !=============================================================================== 191 | 192 | !=============================================================================== 193 | ! TEST_str_loc_next_real: 194 | ! 195 | subroutine TEST_str_loc_next_real( results ) 196 | logical, allocatable, intent(out) :: results(:) 197 | ! local parameters: 198 | integer, parameter :: nTests = 1 199 | 200 | allocate(results(nTests)) 201 | 202 | results(1) = 6 == str_loc_next_real('word;1.0;') 203 | end subroutine TEST_str_loc_next_real 204 | !=============================================================================== 205 | 206 | !=============================================================================== 207 | ! TEST_str_parse_next_delimiter: 208 | ! 209 | subroutine TEST_str_parse_next_delimiter( results ) 210 | logical, allocatable, intent(out) :: results(:) 211 | ! local parameters: 212 | integer, parameter :: nTests = 2 213 | ! local variables: 214 | integer :: i 215 | character(:), allocatable :: str 216 | character(:), allocatable :: delimiter 217 | 218 | allocate(results(nTests)) 219 | 220 | i = 1 221 | str = 'word space double-space' 222 | call str_parse_next_delimiter(str, i, delimiter) 223 | results(1) = delimiter == ' ' .and. i == 6 224 | 225 | call str_parse_next_delimiter(str, i, delimiter) 226 | results(2) = delimiter == ' ' .and. i == 13 227 | end subroutine TEST_str_parse_next_delimiter 228 | !=============================================================================== 229 | 230 | !=============================================================================== 231 | ! TEST_str_parse_next_space: 232 | ! 233 | subroutine TEST_str_parse_next_space( results ) 234 | logical, allocatable, intent(out) :: results(:) 235 | ! local parameters: 236 | integer, parameter :: nTests = 2 237 | ! local variables: 238 | integer :: i 239 | character(:), allocatable :: str 240 | character(:), allocatable :: space 241 | 242 | allocate(results(nTests)) 243 | 244 | i = 1 245 | str = 'word space double-space' 246 | call str_parse_next_space(str, i, space) 247 | results(1) = space == ' ' .and. i == 6 248 | 249 | call str_parse_next_space(str, i, space) 250 | results(2) = space == ' ' .and. i == 13 251 | end subroutine TEST_str_parse_next_space 252 | !=============================================================================== 253 | 254 | !=============================================================================== 255 | ! TEST_str_parse_next_token: 256 | ! 257 | subroutine TEST_str_parse_next_token( results ) 258 | logical, allocatable, intent(out) :: results(:) 259 | ! local parameters: 260 | integer, parameter :: nTests = 3 261 | ! local variables: 262 | integer :: i 263 | character(:), allocatable :: str 264 | character(:), allocatable :: token 265 | 266 | allocate(results(nTests)) 267 | 268 | i = 1 269 | str = 'word; 100, w10' 270 | call str_parse_next_token(str, i, token) 271 | results(1) = token == 'word' .and. i == 5 272 | 273 | call str_parse_next_token(str, i, token) 274 | results(2) = token == '100' .and. i == 10 275 | 276 | call str_parse_next_token(str, i, token) 277 | results(3) = token == 'w10' .and. i == 15 278 | end subroutine TEST_str_parse_next_token 279 | !=============================================================================== 280 | end program main 281 | !=============================================================================== 282 | --------------------------------------------------------------------------------