diff --git a/doc/specs/stdlib_ascii.md b/doc/specs/stdlib_ascii.md index 5a6653337..d38fe87bf 100644 --- a/doc/specs/stdlib_ascii.md +++ b/doc/specs/stdlib_ascii.md @@ -169,3 +169,42 @@ program demo_reverse print'(a)', reverse("Hello, World!") ! returns "!dlroW ,olleH" end program demo_reverse ``` + + +### `to_string` + +#### Status + +Experimental + +#### Description + +Create a character string representing the value of the provided variable. + +#### Syntax + +`res = [[stdlib_ascii(module):to_string(interface)]] (string)` + +#### Class + +Pure function. + +#### Argument + +`val`: shall be an intrinsic integer or logical type. It is an `intent(in)` argument. + +#### Result value + +The result is an intrinsic character type. + +#### Example + +```fortran +program demo_string_value + use stdlib_ascii, only : to_string + implicit none + print'(a)', to_string(-3) ! returns "-3" + print'(a)', to_string(.true.) ! returns "T" + print'(a)', to_string(42) ! returns "42" +end program demo_string_value +``` diff --git a/doc/specs/stdlib_string_type.md b/doc/specs/stdlib_string_type.md index 63c38ccf4..30e5c1755 100644 --- a/doc/specs/stdlib_string_type.md +++ b/doc/specs/stdlib_string_type.md @@ -123,6 +123,90 @@ end program demo ``` + +### Constructor from integer scalar + +#### Description + +The module defines a constructor to create a string type from an integer scalar. + +#### Syntax + +`res = [[stdlib_string_type(module):string_type(interface)]] (string)` + +#### Status + +Experimental + +#### Class + +Elemental function. + +#### Argument + +`val`: shall be a scalar integer value. It is an `intent(in)` argument. + +#### Result value + +The result is an instance of `string_type`. + +#### Example + +```fortran +program demo + use stdlib_string_type + implicit none + type(string_type) :: string + string = string_type(42) + ! len(string) == 2 + string = string_type(-289) + ! len(string) == 4 +end program demo +``` + + + +### Constructor from logical scalar + +#### Description + +The module defines a constructor to create a string type from a logical scalar. + +#### Syntax + +`res = [[stdlib_string_type(module):string_type(interface)]] (string)` + +#### Status + +Experimental + +#### Class + +Elemental function. + +#### Argument + +`val`: shall be a scalar logical value. It is an `intent(in)` argument. + +#### Result value + +The result is an instance of `string_type`. + +#### Example + +```fortran +program demo + use stdlib_string_type + implicit none + type(string_type) :: string + string = string_type(.true.) + ! len(string) == 1 + string = string_type(.false.) + ! len(string) == 1 +end program demo +``` + + ### Assignment of character scalar @@ -143,7 +227,7 @@ Experimental #### Class -Elemntal subroutine, `assignment(=)`. +Elemental subroutine, `assignment(=)`. #### Example diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 96a6ebcce..91be20685 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -2,6 +2,7 @@ # Create a list of the files to be preprocessed set(fppFiles + stdlib_ascii.fypp stdlib_bitsets.fypp stdlib_bitsets_64.fypp stdlib_bitsets_large.fypp @@ -22,6 +23,7 @@ set(fppFiles stdlib_quadrature_trapz.fypp stdlib_quadrature_simps.fypp stdlib_stats_distribution_PRNG.fypp + stdlib_string_type.fypp ) @@ -37,11 +39,9 @@ endif() fypp_f90("${fyppFlags}" "${fppFiles}" outFiles) set(SRC - stdlib_ascii.f90 stdlib_error.f90 stdlib_kinds.f90 stdlib_logger.f90 - stdlib_string_type.f90 stdlib_strings.f90 stdlib_system.F90 ${outFiles} diff --git a/src/Makefile.manual b/src/Makefile.manual index 85541e038..37d54dc3c 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -1,4 +1,5 @@ SRCFYPP =\ + stdlib_ascii.fypp \ stdlib_bitsets_64.fypp \ stdlib_bitsets_large.fypp \ stdlib_bitsets.fypp \ @@ -18,15 +19,14 @@ SRCFYPP =\ stdlib_stats_moment_mask.fypp \ stdlib_stats_moment_scalar.fypp \ stdlib_stats_var.fypp \ - stdlib_stats_distribution_PRNG.fypp + stdlib_stats_distribution_PRNG.fypp \ + stdlib_string_type.fypp SRC = f18estop.f90 \ - stdlib_ascii.f90 \ stdlib_error.f90 \ stdlib_kinds.f90 \ stdlib_logger.f90 \ stdlib_strings.f90 \ - stdlib_string_type.f90 \ $(SRCGEN) LIB = libstdlib.a @@ -55,6 +55,7 @@ $(SRCGEN): %.f90: %.fypp common.fypp # Fortran module dependencies f18estop.o: stdlib_error.o +stdlib_ascii.o: stdlib_kinds.o stdlib_bitsets.o: stdlib_kinds.o stdlib_bitsets_64.o: stdlib_bitsets.o stdlib_bitsets_large.o: stdlib_bitsets.o @@ -110,5 +111,5 @@ stdlib_stats_var.o: \ stdlib_stats_distribution_PRNG.o: \ stdlib_kinds.o \ stdlib_error.o -stdlib_string_type.o: stdlib_ascii.o +stdlib_string_type.o: stdlib_ascii.o stdlib_kinds.o stdlib_strings.o: stdlib_ascii.o stdlib_string_type.o diff --git a/src/stdlib_ascii.f90 b/src/stdlib_ascii.fypp similarity index 87% rename from src/stdlib_ascii.f90 rename to src/stdlib_ascii.fypp index e446f29e2..08816949a 100644 --- a/src/stdlib_ascii.f90 +++ b/src/stdlib_ascii.fypp @@ -1,8 +1,11 @@ +#:include "common.fypp" + !> The `stdlib_ascii` module provides procedures for handling and manipulating !> intrinsic character variables and constants. !> !> The specification of this module is available [here](../page/specs/stdlib_ascii.html). module stdlib_ascii + use stdlib_kinds, only : int8, int16, int32, int64 implicit none private @@ -17,6 +20,17 @@ module stdlib_ascii ! Character conversion functions public :: to_lower, to_upper, to_title, reverse + public :: to_string + + !> Version: experimental + !> + !> Create a character string representing the value of the provided variable. + interface to_string + #:for kind in INT_KINDS + module procedure :: to_string_integer_${kind}$ + module procedure :: to_string_logical_${kind}$ + #:endfor + end interface to_string ! All control characters in the ASCII table (see www.asciitable.com). character(len=1), public, parameter :: NUL = achar(int(z'00')) !! Null @@ -312,4 +326,51 @@ pure function reverse(string) result(reverse_string) end function reverse + #:for kind in INT_KINDS + !> Represent an integer of kind ${kind}$ as character sequence + pure function to_string_integer_${kind}$(val) result(string) + integer, parameter :: ik = ${kind}$ + integer(ik), intent(in) :: val + character(len=:), allocatable :: string + integer, parameter :: buffer_len = range(val)+2 + character(len=buffer_len) :: buffer + integer :: pos + integer(ik) :: n + character(len=1), parameter :: numbers(0:9) = & + ["0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] + + if (val == 0_ik) then + string = numbers(0) + return + end if + + n = abs(val) + buffer = "" + + pos = buffer_len + 1 + do while (n > 0_ik) + pos = pos - 1 + buffer(pos:pos) = numbers(mod(n, 10_ik)) + n = n/10_ik + end do + if (val < 0_ik) then + pos = pos - 1 + buffer(pos:pos) = '-' + end if + + string = buffer(pos:) + end function to_string_integer_${kind}$ + #:endfor + + #:for kind in INT_KINDS + !> Represent an logical of kind ${kind}$ as character sequence + pure function to_string_logical_${kind}$(val) result(string) + integer, parameter :: ik = ${kind}$ + logical(ik), intent(in) :: val + character(len=1) :: string + + string = merge("T", "F", val) + end function to_string_logical_${kind}$ + #:endfor + end module stdlib_ascii diff --git a/src/stdlib_string_type.f90 b/src/stdlib_string_type.fypp similarity index 97% rename from src/stdlib_string_type.f90 rename to src/stdlib_string_type.fypp index 2b46a5de9..21422cd21 100644 --- a/src/stdlib_string_type.f90 +++ b/src/stdlib_string_type.fypp @@ -1,4 +1,5 @@ ! SPDX-Identifier: MIT +#:include "common.fypp" !> Implementation of a string type to hold an arbitrary sequence of characters. !> @@ -13,8 +14,8 @@ !> The specification of this module is available [here](../page/specs/stdlib_string_type.html). module stdlib_string_type use stdlib_ascii, only: to_lower_ => to_lower, to_upper_ => to_upper, & - to_title_ => to_title, reverse_ => reverse - + & to_title_ => to_title, reverse_ => reverse, to_string + use stdlib_kinds, only : int8, int16, int32, int64 implicit none private @@ -44,6 +45,10 @@ module stdlib_string_type !> Constructor for new string instances interface string_type module procedure :: new_string + #:for kind in INT_KINDS + module procedure :: new_string_from_integer_${kind}$ + module procedure :: new_string_from_logical_${kind}$ + #:endfor end interface string_type @@ -351,6 +356,24 @@ elemental function new_string(string) result(new) end if end function new_string + #:for kind in INT_KINDS + !> Constructor for new string instances from an integer of kind ${kind}$. + elemental function new_string_from_integer_${kind}$(val) result(new) + integer(${kind}$), intent(in) :: val + type(string_type) :: new + new%raw = to_string(val) + end function new_string_from_integer_${kind}$ + #:endfor + + #:for kind in INT_KINDS + !> Constructor for new string instances from a logical of kind ${kind}$. + elemental function new_string_from_logical_${kind}$(val) result(new) + logical(${kind}$), intent(in) :: val + type(string_type) :: new + new%raw = to_string(val) + end function new_string_from_logical_${kind}$ + #:endfor + !> Assign a character sequence to a string. elemental subroutine assign_string_char(lhs, rhs) diff --git a/src/tests/ascii/test_ascii.f90 b/src/tests/ascii/test_ascii.f90 index cfe4a938c..ba8e377fa 100644 --- a/src/tests/ascii/test_ascii.f90 +++ b/src/tests/ascii/test_ascii.f90 @@ -6,7 +6,9 @@ program test_ascii whitespace, letters, is_alphanum, is_alpha, is_lower, is_upper, & is_digit, is_octal_digit, is_hex_digit, is_white, is_blank, & is_control, is_punctuation, is_graphical, is_printable, is_ascii, & - to_lower, to_upper, to_title, reverse, LF, TAB, NUL, DEL + to_lower, to_upper, to_title, reverse, LF, TAB, NUL, DEL, & + to_string + use stdlib_kinds, only : int8, int16, int32, int64 implicit none @@ -73,6 +75,8 @@ program test_ascii call test_to_title_string call test_reverse_string + call test_to_string + contains subroutine test_is_alphanum_short @@ -613,4 +617,47 @@ subroutine test_reverse_string call check(trim(adjustl(dlc)) == "desrever") end subroutine test_reverse_string + subroutine test_to_string + character(len=128) :: flc + + write(flc, '(g0)') 1026192 + call check(to_string(1026192) == trim(flc)) + + write(flc, '(g0)') -124784 + call check(to_string(-124784) == trim(flc)) + + write(flc, '(g0)') 1_int8 + call check(to_string(1_int8) == trim(flc)) + + write(flc, '(g0)') -3_int8 + call check(to_string(-3_int8) == trim(flc)) + + write(flc, '(g0)') 80_int16 + call check(to_string(80_int16) == trim(flc)) + + write(flc, '(g0)') 8924890_int32 + call check(to_string(8924890_int32) == trim(flc)) + + write(flc, '(g0)') -2378401_int32 + call check(to_string(-2378401_int32) == trim(flc)) + + write(flc, '(g0)') -921092378401_int64 + call check(to_string(-921092378401_int64) == trim(flc)) + + write(flc, '(g0)') 1272835771_int64 + call check(to_string(1272835771_int64) == trim(flc)) + + write(flc, '(g0)') .true. + call check(to_string(.true.) == trim(flc)) + + write(flc, '(g0)') .false. + call check(to_string(.false.) == trim(flc)) + + write(flc, '(g0)') .true._int8 + call check(to_string(.true._int8) == trim(flc)) + + write(flc, '(g0)') .false._int64 + call check(to_string(.false._int64) == trim(flc)) + end subroutine test_to_string + end program test_ascii diff --git a/src/tests/string/test_string_assignment.f90 b/src/tests/string/test_string_assignment.f90 index f76c8724a..6fe9255a2 100644 --- a/src/tests/string/test_string_assignment.f90 +++ b/src/tests/string/test_string_assignment.f90 @@ -1,7 +1,8 @@ ! SPDX-Identifier: MIT module test_string_assignment use stdlib_error, only : check - use stdlib_string_type, only : string_type, assignment(=), len + use stdlib_kinds, only : int8, int16, int32, int64 + use stdlib_string_type, only : string_type, assignment(=), operator(==), len implicit none contains @@ -15,6 +16,49 @@ subroutine test_assignment call check(len(string) == 8) end subroutine test_assignment + subroutine test_char_value + character(len=128) :: flc + + write(flc, '(g0)') -1026191 + call check(string_type(-1026191) == trim(flc)) + + write(flc, '(g0)') 124787 + call check(string_type(124787) == trim(flc)) + + write(flc, '(g0)') -2_int8 + call check(string_type(-2_int8) == trim(flc)) + + write(flc, '(g0)') 5_int8 + call check(string_type(5_int8) == trim(flc)) + + write(flc, '(g0)') -72_int16 + call check(string_type(-72_int16) == trim(flc)) + + write(flc, '(g0)') -8924889_int32 + call check(string_type(-8924889_int32) == trim(flc)) + + write(flc, '(g0)') 2378405_int32 + call check(string_type(2378405_int32) == trim(flc)) + + write(flc, '(g0)') 921092378411_int64 + call check(string_type(921092378411_int64) == trim(flc)) + + write(flc, '(g0)') -1272835761_int64 + call check(string_type(-1272835761_int64) == trim(flc)) + + write(flc, '(g0)') .true. + call check(string_type(.true.) == trim(flc)) + + write(flc, '(g0)') .false. + call check(string_type(.false.) == trim(flc)) + + write(flc, '(g0)') .false._int8 + call check(string_type(.false._int8) == trim(flc)) + + write(flc, '(g0)') .true._int64 + call check(string_type(.true._int64) == trim(flc)) + end subroutine test_char_value + end module test_string_assignment program tester @@ -22,6 +66,7 @@ program tester implicit none call test_assignment + call test_char_value end program tester