From 1918f916060de8db5fb4e727e9c853dccab00cb2 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Wed, 7 Jul 2021 00:01:54 +0530 Subject: [PATCH 1/7] implemented move_alloc for string_type --- src/stdlib_string_type.fypp | 39 +++++++++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) diff --git a/src/stdlib_string_type.fypp b/src/stdlib_string_type.fypp index a802830b2..1863de5da 100644 --- a/src/stdlib_string_type.fypp +++ b/src/stdlib_string_type.fypp @@ -206,6 +206,16 @@ module stdlib_string_type module procedure :: verify_char_string end interface verify + !> Version: experimental + !> + !> Moves the allocated character scalar from 'from' to 'to' + !> [Specifications](../page/specs/stdlib_string_type.html#move) + interface move + module procedure :: move_string_string + module procedure :: move_string_char + module procedure :: move_char_string + end interface move + !> Lexically compare the order of two character sequences being greater, !> The left-hand side, the right-hand side or both character sequences can !> be represented by a string. @@ -721,6 +731,35 @@ contains end function verify_char_string + !> Moves the allocated character scalar from 'from' to 'to' + !> No output + subroutine move_string_string(from, to) + type(string_type), intent(inout) :: from + type(string_type), intent(out) :: to + + call move_alloc(from%raw, to%raw) + + end subroutine move_string_string + + !> Moves the allocated character scalar from 'from' to 'to' + !> No output + subroutine move_string_char(from, to) + type(string_type), intent(inout) :: from + character(len=:), intent(out), allocatable :: to + + call move_alloc(from%raw, to) + + end subroutine move_string_char + + !> Moves the allocated character scalar from 'from' to 'to' + !> No output + subroutine move_char_string(from, to) + character(len=:), intent(inout), allocatable :: from + type(string_type), intent(out) :: to + + call move_alloc(from, to%raw) + + end subroutine move_char_string !> Compare two character sequences for being greater. !> In this version both character sequences are by a string. From 754f798c76641de4fea2ba4ae28e46db2dd0944e Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Fri, 16 Jul 2021 20:21:55 +0530 Subject: [PATCH 2/7] made move public --- src/stdlib_string_type.fypp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_string_type.fypp b/src/stdlib_string_type.fypp index 1863de5da..05632be70 100644 --- a/src/stdlib_string_type.fypp +++ b/src/stdlib_string_type.fypp @@ -22,7 +22,7 @@ module stdlib_string_type public :: string_type public :: len, len_trim, trim, index, scan, verify, repeat, adjustr, adjustl public :: lgt, lge, llt, lle, char, ichar, iachar - public :: to_lower, to_upper, to_title, to_sentence, reverse + public :: to_lower, to_upper, to_title, to_sentence, reverse, move public :: assignment(=) public :: operator(>), operator(>=), operator(<), operator(<=) public :: operator(==), operator(/=), operator(//) From a77931c7815c97ca91cff4a256e9e3dc235516c2 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Fri, 16 Jul 2021 20:23:22 +0530 Subject: [PATCH 3/7] added test cases for move --- src/tests/string/test_string_intrinsic.f90 | 35 ++++++++++++++++++++++ 1 file changed, 35 insertions(+) diff --git a/src/tests/string/test_string_intrinsic.f90 b/src/tests/string/test_string_intrinsic.f90 index e546a73ff..bdc49a251 100644 --- a/src/tests/string/test_string_intrinsic.f90 +++ b/src/tests/string/test_string_intrinsic.f90 @@ -463,6 +463,40 @@ subroutine test_iachar call check(code == iachar("F")) end subroutine test_iachar + subroutine test_move + type(string_type) :: from_string + type(string_type) :: to_string + character(len=:), allocatable :: from_char + + from_string = "Move This String" + from_char = "Move This Char" + call check(from_string == "Move This String" .and. to_string == "" .and. & + & from_char == "Move This Char", "move: test_case 1") + + ! string_type (allocated) --> string_type (not allocated) + call move(from_string, to_string) + call check(from_string == "" .and. to_string == "Move This String", "move: test_case 2") + + ! character (allocated) --> string_type (not allocated) + call move(from_char, from_string) + call check(.not. allocated(from_char) .and. from_string == "Move This Char", & + & "move: test_case 3") + + ! string_type (allocated) --> character (not allocated) + call move(to_string, from_char) + call check(to_string == "" .and. from_char == "Move This String", "move: test_case 4") + + ! character (allocated) --> string_type (allocated) + call move(from_char, from_string) + call check(.not. allocated(from_char) .and. from_string == "Move This String", & + & "move: test_case 5") + + ! character (allocated) --> string_type (allocated) + call move(from_char, from_string) + call check(.not. allocated(from_char) .and. from_string == "", "move: test_case 6") + + end subroutine test_move + end module test_string_intrinsic program tester @@ -485,5 +519,6 @@ program tester call test_char call test_ichar call test_iachar + call test_move end program tester From e0c8b8f776e504367e8ef571f3ca7c016f93b932 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Fri, 16 Jul 2021 20:24:21 +0530 Subject: [PATCH 4/7] documented move --- doc/specs/stdlib_string_type.md | 55 +++++++++++++++++++++++++++++++++ 1 file changed, 55 insertions(+) diff --git a/doc/specs/stdlib_string_type.md b/doc/specs/stdlib_string_type.md index 3a809171e..a0c4335e7 100644 --- a/doc/specs/stdlib_string_type.md +++ b/doc/specs/stdlib_string_type.md @@ -1972,3 +1972,58 @@ program demo close(io) end program demo ``` + + + +### move + +#### Description + +Moves the allocation from `from` to `to`, consequently deallocating `from` in this process. +If `from` is not allocated before execution, `to` gets deallocated by the process. +An unallocated string is equivalent to an empty string. + +#### Syntax + +`call [[stdlib_string_type(module):move(interface)]] (from, to)` + +#### Status + +Experimental + +#### Class + +Pure Subroutine. + +#### Argument + +- `from`: Character scalar or [[stdlib_string_type(module):string_type(type)]]. + This argument is `intent(inout)`. +- `to`: Character scalar or [[stdlib_string_type(module):string_type(type)]]. + This argument is `intent(out)`. + +#### Example + +```fortran +program demo + use stdlib_string_type, only : string_type, assignment(=), move + implicit none + type(string_type) :: from_string, to_string + character(len=:), allocatable :: from_char + + from_string = "move this string" + from_char = "move this char" + ! from_string <-- "move this string" + ! from_char <-- "move this char" + ! to_string <-- "" (unallocated) + + call move(from_string, to_string) + ! from_string <-- "" (unallocated) + ! to_string <-- "move this string" + + call move(from_char, to_string) + ! from_char <-- (unallocated) + ! to_string <-- "move this char" + +end program demo +``` From 73ec8c57d8b168e385f2da0b1a1960235a8c5aaf Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Wed, 28 Jul 2021 12:07:06 +0530 Subject: [PATCH 5/7] added move for both arguments as character allocatables --- src/stdlib_string_type.fypp | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/src/stdlib_string_type.fypp b/src/stdlib_string_type.fypp index 05632be70..f4229289a 100644 --- a/src/stdlib_string_type.fypp +++ b/src/stdlib_string_type.fypp @@ -214,6 +214,7 @@ module stdlib_string_type module procedure :: move_string_string module procedure :: move_string_char module procedure :: move_char_string + module procedure :: move_char_char end interface move !> Lexically compare the order of two character sequences being greater, @@ -761,6 +762,16 @@ contains end subroutine move_char_string + !> Moves the allocated character scalar from 'from' to 'to' + !> No output + subroutine move_char_char(from, to) + character(len=:), intent(inout), allocatable :: from + character(len=:), intent(inout), allocatable :: to + + call move_alloc(from, to) + + end subroutine move_char_char + !> Compare two character sequences for being greater. !> In this version both character sequences are by a string. elemental function gt_string_string(lhs, rhs) result(is_gt) From b79da2438d41e75b911713448f0c72bb939eddb4 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Wed, 28 Jul 2021 15:07:41 +0530 Subject: [PATCH 6/7] made 'inout' to 'out' in 'to' argument of move_char_char --- src/stdlib_string_type.fypp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_string_type.fypp b/src/stdlib_string_type.fypp index f4229289a..9e85c34a9 100644 --- a/src/stdlib_string_type.fypp +++ b/src/stdlib_string_type.fypp @@ -766,7 +766,7 @@ contains !> No output subroutine move_char_char(from, to) character(len=:), intent(inout), allocatable :: from - character(len=:), intent(inout), allocatable :: to + character(len=:), intent(out), allocatable :: to call move_alloc(from, to) From 8b19b35176913cb856b70052ae883716705b2cd7 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Wed, 25 Aug 2021 22:35:59 +0530 Subject: [PATCH 7/7] improved documentation and added new test cases --- doc/specs/stdlib_string_type.md | 20 ++++++++-------- src/tests/string/test_string_intrinsic.f90 | 28 +++++++++++++++------- 2 files changed, 29 insertions(+), 19 deletions(-) diff --git a/doc/specs/stdlib_string_type.md b/doc/specs/stdlib_string_type.md index a0c4335e7..4c6d84194 100644 --- a/doc/specs/stdlib_string_type.md +++ b/doc/specs/stdlib_string_type.md @@ -1981,7 +1981,7 @@ end program demo Moves the allocation from `from` to `to`, consequently deallocating `from` in this process. If `from` is not allocated before execution, `to` gets deallocated by the process. -An unallocated string is equivalent to an empty string. +An unallocated `string_type` instance is equivalent to an empty string. #### Syntax @@ -2005,25 +2005,25 @@ Pure Subroutine. #### Example ```fortran -program demo +program demo_move use stdlib_string_type, only : string_type, assignment(=), move implicit none - type(string_type) :: from_string, to_string - character(len=:), allocatable :: from_char + type(string_type) :: from_string + character(len=:), allocatable :: from_char, to_char from_string = "move this string" from_char = "move this char" ! from_string <-- "move this string" ! from_char <-- "move this char" - ! to_string <-- "" (unallocated) + ! to_char <-- (unallocated) - call move(from_string, to_string) - ! from_string <-- "" (unallocated) - ! to_string <-- "move this string" + call move(from_string, to_char) + ! from_string <-- "" + ! to_char <-- "move this string" - call move(from_char, to_string) + call move(from_char, to_char) ! from_char <-- (unallocated) ! to_string <-- "move this char" -end program demo +end program demo_move ``` diff --git a/src/tests/string/test_string_intrinsic.f90 b/src/tests/string/test_string_intrinsic.f90 index bdc49a251..47427eab2 100644 --- a/src/tests/string/test_string_intrinsic.f90 +++ b/src/tests/string/test_string_intrinsic.f90 @@ -464,14 +464,14 @@ subroutine test_iachar end subroutine test_iachar subroutine test_move - type(string_type) :: from_string - type(string_type) :: to_string - character(len=:), allocatable :: from_char + type(string_type) :: from_string, to_string + character(len=:), allocatable :: from_char, to_char from_string = "Move This String" from_char = "Move This Char" call check(from_string == "Move This String" .and. to_string == "" .and. & - & from_char == "Move This Char", "move: test_case 1") + & from_char == "Move This Char" .and. .not. allocated(to_char), & + & "move: test_case 1") ! string_type (allocated) --> string_type (not allocated) call move(from_string, to_string) @@ -483,17 +483,27 @@ subroutine test_move & "move: test_case 3") ! string_type (allocated) --> character (not allocated) - call move(to_string, from_char) - call check(to_string == "" .and. from_char == "Move This String", "move: test_case 4") + call move(to_string, to_char) + call check(to_string == "" .and. to_char == "Move This String", "move: test_case 4") ! character (allocated) --> string_type (allocated) - call move(from_char, from_string) - call check(.not. allocated(from_char) .and. from_string == "Move This String", & + call move(to_char, from_string) + call check(.not. allocated(to_char) .and. from_string == "Move This String", & & "move: test_case 5") + from_char = "new char" ! character (allocated) --> string_type (allocated) call move(from_char, from_string) - call check(.not. allocated(from_char) .and. from_string == "", "move: test_case 6") + call check(.not. allocated(from_char) .and. from_string == "new char", "move: test_case 6") + + ! character (unallocated) --> string_type (allocated) + call move(from_char, from_string) + call check(from_string == "", "move: test_case 7") + + from_string = "moving to self" + ! string_type (allocated) --> string_type (allocated) + call move(from_string, from_string) + call check(from_string == "", "move: test_case 8") end subroutine test_move