Skip to content

Commit 591678d

Browse files
committed
Update documentation comments in stdlib_ascii
1 parent e47f028 commit 591678d

File tree

1 file changed

+22
-10
lines changed

1 file changed

+22
-10
lines changed

src/stdlib_ascii.f90

Lines changed: 22 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,7 @@
1+
!> The `stdlib_ascii` module provides procedures for handling and manipulating
2+
!> intrinsic character variables and constants.
3+
!>
4+
!> The specification of this module is available [here](../page/specs/stdlib_ascii.html).
15
module stdlib_ascii
26

37
implicit none
@@ -76,7 +80,7 @@ pure logical function is_alphanum(c)
7680
end function
7781

7882
!> Checks whether or not `c` is in the ASCII character set -
79-
! i.e. in the range 0 .. 0x7F.
83+
!> i.e. in the range 0 .. 0x7F.
8084
pure logical function is_ascii(c)
8185
character(len=1), intent(in) :: c !! The character to test.
8286
is_ascii = iachar(c) <= int(z'7F')
@@ -110,8 +114,8 @@ pure logical function is_hex_digit(c)
110114
end function
111115

112116
!> Checks whether or not `c` is a punctuation character. That includes
113-
! all ASCII characters which are not control characters, letters,
114-
! digits, or whitespace.
117+
!> all ASCII characters which are not control characters, letters,
118+
!> digits, or whitespace.
115119
pure logical function is_punctuation(c)
116120
character(len=1), intent(in) :: c !! The character to test.
117121
integer :: ic
@@ -121,7 +125,7 @@ pure logical function is_punctuation(c)
121125
end function
122126

123127
!> Checks whether or not `c` is a printable character other than the
124-
! space character.
128+
!> space character.
125129
pure logical function is_graphical(c)
126130
character(len=1), intent(in) :: c !! The character to test.
127131
integer :: ic
@@ -132,7 +136,7 @@ pure logical function is_graphical(c)
132136
end function
133137

134138
!> Checks whether or not `c` is a printable character - including the
135-
! space character.
139+
!> space character.
136140
pure logical function is_printable(c)
137141
character(len=1), intent(in) :: c !! The character to test.
138142
integer :: ic
@@ -156,8 +160,8 @@ pure logical function is_upper(c)
156160
end function
157161

158162
!> Checks whether or not `c` is a whitespace character. That includes the
159-
! space, tab, vertical tab, form feed, carriage return, and linefeed
160-
! characters.
163+
!> space, tab, vertical tab, form feed, carriage return, and linefeed
164+
!> characters.
161165
pure logical function is_white(c)
162166
character(len=1), intent(in) :: c !! The character to test.
163167
integer :: ic
@@ -166,7 +170,7 @@ pure logical function is_white(c)
166170
end function
167171

168172
!> Checks whether or not `c` is a blank character. That includes the
169-
! only the space and tab characters
173+
!> only the space and tab characters
170174
pure logical function is_blank(c)
171175
character(len=1), intent(in) :: c !! The character to test.
172176
integer :: ic
@@ -175,7 +179,7 @@ pure logical function is_blank(c)
175179
end function
176180

177181
!> Returns the corresponding lowercase letter, if `c` is an uppercase
178-
! ASCII character, otherwise `c` itself.
182+
!> ASCII character, otherwise `c` itself.
179183
pure function char_to_lower(c) result(t)
180184
character(len=1), intent(in) :: c !! A character.
181185
character(len=1) :: t
@@ -191,7 +195,7 @@ pure function char_to_lower(c) result(t)
191195
end function char_to_lower
192196

193197
!> Returns the corresponding uppercase letter, if `c` is a lowercase
194-
! ASCII character, otherwise `c` itself.
198+
!> ASCII character, otherwise `c` itself.
195199
pure function char_to_upper(c) result(t)
196200
character(len=1), intent(in) :: c !! A character.
197201
character(len=1) :: t
@@ -207,6 +211,8 @@ pure function char_to_upper(c) result(t)
207211
end function char_to_upper
208212

209213
!> Convert character variable to lower case
214+
!>
215+
!> Version: experimental
210216
pure function to_lower(string) result(lower_string)
211217
character(len=*), intent(in) :: string
212218
character(len=len(string)) :: lower_string
@@ -219,6 +225,8 @@ pure function to_lower(string) result(lower_string)
219225
end function to_lower
220226

221227
!> Convert character variable to upper case
228+
!>
229+
!> Version: experimental
222230
pure function to_upper(string) result(upper_string)
223231
character(len=*), intent(in) :: string
224232
character(len=len(string)) :: upper_string
@@ -231,6 +239,8 @@ pure function to_upper(string) result(upper_string)
231239
end function to_upper
232240

233241
!> Convert character variable to title case
242+
!>
243+
!> Version: experimental
234244
pure function to_title(string) result(title_string)
235245
character(len=*), intent(in) :: string
236246
character(len=len(string)) :: title_string
@@ -254,6 +264,8 @@ pure function to_title(string) result(title_string)
254264
end function to_title
255265

256266
!> Reverse the character order in the input character variable
267+
!>
268+
!> Version: experimental
257269
pure function reverse(string) result(reverse_string)
258270
character(len=*), intent(in) :: string
259271
character(len=len(string)) :: reverse_string

0 commit comments

Comments
 (0)