Skip to content

Commit 1be7ca3

Browse files
wclodius2wclodius2
committed
2 parents acb7cdb + d20faf8 commit 1be7ca3

File tree

3 files changed

+96
-42
lines changed

3 files changed

+96
-42
lines changed

‎src/stdlib_ascii.f90‎

Lines changed: 35 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -60,6 +60,9 @@ module stdlib_ascii
6060
character(len=*), public, parameter :: lowercase = letters(27:) !! a .. z
6161
character(len=*), public, parameter :: whitespace = " "//TAB//VT//CR//LF//FF !! ASCII _whitespace
6262

63+
character(len=26), parameter, private :: lower_case = 'abcdefghijklmnopqrstuvwxyz'
64+
character(len=26), parameter, private :: upper_case = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
65+
6366
contains
6467

6568
!> Checks whether `c` is an ASCII letter (A .. Z, a .. z).
@@ -135,7 +138,9 @@ pure logical function is_punctuation(c)
135138
pure logical function is_graphical(c)
136139
character(len=1), intent(in) :: c !! The character to test.
137140
integer :: ic
138-
ic = iachar(c) ! '!' '~'
141+
ic = iachar(c)
142+
!The character is graphical if it's between '!' and '~' in the ASCII table,
143+
!that is: printable but not a space
139144
is_graphical = (int(z'21') <= ic) .and. (ic <= int(z'7E'))
140145
end function
141146

@@ -144,22 +149,25 @@ pure logical function is_graphical(c)
144149
pure logical function is_printable(c)
145150
character(len=1), intent(in) :: c !! The character to test.
146151
integer :: ic
147-
ic = iachar(c) ! '~'
148-
is_printable = c >= ' ' .and. ic <= int(z'7E')
152+
ic = iachar(c)
153+
!The character is printable if it's between ' ' and '~' in the ASCII table
154+
is_printable = ic >= iachar(' ') .and. ic <= int(z'7E')
149155
end function
150156

151157
!> Checks whether `c` is a lowercase ASCII letter (a .. z).
152158
pure logical function is_lower(c)
153159
character(len=1), intent(in) :: c !! The character to test.
154-
is_lower = (c >= 'a') .and. (c <= 'z')
160+
integer :: ic
161+
ic = iachar(c)
162+
is_lower = ic >= iachar('a') .and. ic <= iachar('z')
155163
end function
156164

157165
!> Checks whether `c` is an uppercase ASCII letter (A .. Z).
158166
pure logical function is_upper(c)
159167
character(len=1), intent(in) :: c !! The character to test.
160168
integer :: ic
161169
ic = iachar(c)
162-
is_upper = (ic >= iachar('A')) .and. (ic <= iachar('Z'))
170+
is_upper = ic >= iachar('A') .and. ic <= iachar('Z')
163171
end function
164172

165173
!> Checks whether or not `c` is a whitespace character. That includes the
@@ -169,7 +177,7 @@ pure logical function is_white(c)
169177
character(len=1), intent(in) :: c !! The character to test.
170178
integer :: ic
171179
ic = iachar(c) ! TAB, LF, VT, FF, CR
172-
is_white = (ic == iachar(' ')) .or. (ic >= int(z'09') .and. ic <= int(z'0D'));
180+
is_white = ic == iachar(' ') .or. (ic >= int(z'09') .and. ic <= int(z'0D'))
173181
end function
174182

175183
!> Checks whether or not `c` is a blank character. That includes the
@@ -178,31 +186,39 @@ pure logical function is_blank(c)
178186
character(len=1), intent(in) :: c !! The character to test.
179187
integer :: ic
180188
ic = iachar(c) ! TAB
181-
is_blank = (ic == iachar(' ')) .or. (ic == int(z'09'));
189+
is_blank = ic == iachar(' ') .or. ic == int(z'09')
182190
end function
183191

184192
!> Returns the corresponding lowercase letter, if `c` is an uppercase
185193
! ASCII character, otherwise `c` itself.
186194
pure function to_lower(c) result(t)
187195
character(len=1), intent(in) :: c !! A character.
188-
character(len=1) :: t
189-
integer :: diff
190-
diff = iachar('A')-iachar('a')
191-
t = c
192-
! if uppercase, make lowercase
193-
if (is_upper(t)) t = achar(iachar(t) - diff)
196+
character(len=1) :: t
197+
integer :: k
198+
199+
k = index( upper_case, c )
200+
201+
if ( k > 0 ) then
202+
t = lower_case(k:k)
203+
else
204+
t = c
205+
endif
194206
end function
195207

196208
!> Returns the corresponding uppercase letter, if `c` is a lowercase
197209
! ASCII character, otherwise `c` itself.
198210
pure function to_upper(c) result(t)
199211
character(len=1), intent(in) :: c !! A character.
200-
character(len=1) :: t
201-
integer :: diff
202-
diff = iachar('A')-iachar('a')
203-
t = c
204-
! if lowercase, make uppercase
205-
if (is_lower(t)) t = achar(iachar(t) + diff)
212+
character(len=1) :: t
213+
integer :: k
214+
215+
k = index( lower_case, c )
216+
217+
if ( k > 0 ) then
218+
t = upper_case(k:k)
219+
else
220+
t = c
221+
endif
206222
end function
207223

208224
end module

‎src/stdlib_logger.f90‎

Lines changed: 37 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -523,7 +523,7 @@ subroutine format_output_string( self, unit, string, procedure_name, &
523523
character(*), intent(in) :: procedure_name
524524
character(*), intent(in) :: col_indent
525525

526-
integer :: count, indent_len, index, iostat, length, remain
526+
integer :: count, indent_len, index_, iostat, length, remain
527527
character(256) :: iomsg
528528

529529
length = len_trim(string)
@@ -544,27 +544,32 @@ subroutine format_output_string( self, unit, string, procedure_name, &
544544

545545
subroutine format_first_line()
546546

547-
if ( length <= self % max_width .or. self % max_width == 0 ) then
547+
if ( self % max_width == 0 .or. &
548+
( length <= self % max_width .and. &
549+
index( string(1:length), new_line('a')) == 0 ) ) then
548550
write( unit, '(a)', err=999, iostat=iostat, iomsg=iomsg ) &
549551
string(1:length)
550552
remain = 0
551553
return
552554
else
553555

554-
do index=self % max_width, 1, -1
555-
if ( string(index:index) == ' ' ) exit
556-
end do
556+
index_ = index( string(1:min(length, self % max_width)), new_line('a'))
557+
if ( index_ == 0 ) then
558+
do index_=self % max_width, 1, -1
559+
if ( string(index_:index_) == ' ' ) exit
560+
end do
561+
end if
557562

558-
if ( index == 0 ) then
563+
if ( index_ == 0 ) then
559564
write( unit, '(a)', err=999, iostat=iostat, iomsg=iomsg ) &
560565
string(1:self % max_width)
561566
count = self % max_width
562567
remain = length - count
563568
return
564569
else
565570
write( unit, '(a)', err=999, iostat=iostat, iomsg=iomsg ) &
566-
string(1:index-1)
567-
count = index
571+
string(1:index_-1)
572+
count = index_
568573
remain = length - count
569574
return
570575
end if
@@ -585,20 +590,24 @@ subroutine format_subsequent_line()
585590
return
586591
else
587592

588-
do index=count+self % max_width, count+1, -1
589-
if ( string(index:index) == ' ' ) exit
590-
end do
593+
index_ = count + index( string(count+1:count+self % max_width), &
594+
new_line('a'))
595+
if(index_ == count) then
596+
do index_=count+self % max_width, count+1, -1
597+
if ( string(index_:index_) == ' ' ) exit
598+
end do
599+
end if
591600

592-
if ( index == count ) then
601+
if ( index_ == count ) then
593602
write( unit, '(a)', err=999, iostat=iostat, iomsg=iomsg ) &
594603
string(count+1:count+self % max_width)
595604
count = count + self % max_width
596605
remain = length - count
597606
return
598607
else
599608
write( unit, '(a)', err=999, iostat=iostat, iomsg=iomsg ) &
600-
string(count+1:index)
601-
count = index
609+
string(count+1:index_-1)
610+
count = index_
602611
remain = length - count
603612
return
604613
end if
@@ -611,29 +620,35 @@ end subroutine format_subsequent_line
611620

612621
subroutine indent_format_subsequent_line()
613622

614-
if ( remain <= self % max_width - indent_len ) then
623+
if ( index( string(count+1:length), new_line('a')) == 0 .and. &
624+
remain <= self % max_width - indent_len ) then
615625
write( unit, '(a)', err=999, iostat=iostat, iomsg=iomsg ) &
616626
col_indent // string(count+1:length)
617627
count = length
618628
remain = 0
619629
return
620630
else
621631

622-
do index=count+self % max_width-indent_len, count+1, -1
623-
if ( string(index:index) == ' ' ) exit
624-
end do
632+
index_ = count + index( string(count+1: &
633+
min ( length, count+self % max_width - indent_len) ), &
634+
new_line('a'))
635+
if(index_ == count) then
636+
do index_=count+self % max_width-indent_len, count+1, -1
637+
if ( string(index_:index_) == ' ' ) exit
638+
end do
639+
end if
625640

626-
if ( index == count ) then
641+
if ( index_ == count ) then
627642
write( unit, '(a)', err=999, iostat=iostat, iomsg=iomsg ) &
628-
col_indent // &
643+
col_indent // &
629644
string(count+1:count+self % max_width-indent_len)
630645
count = count + self % max_width - indent_len
631646
remain = length - count
632647
return
633648
else
634649
write( unit, '(a)', err=999, iostat=iostat, iomsg=iomsg ) &
635-
col_indent // string(count+1:index)
636-
count = index
650+
col_indent // string(count+1:index_-1)
651+
count = index_
637652
remain = length - count
638653
return
639654
end if

‎src/tests/logger/test_stdlib_logger.f90‎

Lines changed: 24 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -134,6 +134,14 @@ subroutine test_logging_configuration()
134134
module = 'N/A', &
135135
procedure = 'TEST_STDLIB_LOGGER' )
136136

137+
call global % log_information( 'This message should be output ' // &
138+
'to OUTPUT_UNIT, unlimited in width, not preceded by ' // &
139+
'a blank line, then by a time stamp, then by MODULE % ' // &
140+
'PROCEDURE, be prefixed by INFO. ' // new_line('a') // &
141+
'This is a new line of the same log message.', &
142+
module = 'N/A', &
143+
procedure = 'TEST_STDLIB_LOGGER' )
144+
137145
call global % configure( add_blank_line=.true., indent=.false., &
138146
max_width=72, time_stamp=.false. )
139147

@@ -142,7 +150,7 @@ subroutine test_logging_configuration()
142150
log_units=log_units )
143151

144152
if ( add_blank_line ) then
145-
write(*,*) 'ADD_BLANK_LINE is now .FALSE. as expected.'
153+
write(*,*) 'ADD_BLANK_LINE is now .TRUE. as expected.'
146154

147155
else
148156
error stop 'ADD_BLANKLINE is now .FALSE. contrary to expectations.'
@@ -191,6 +199,13 @@ subroutine test_logging_configuration()
191199
module = 'N/A', &
192200
procedure = 'TEST_STDLIB_LOGGER' )
193201

202+
call global % log_message( 'The last word of the first line ' // &
203+
new_line('a')//'should be "line". "Line"' // new_line('a') // &
204+
'is also the last word for the second line. The following ' // &
205+
'lines should be limited to 72 columns width.' , &
206+
module = 'N/A', &
207+
procedure = 'TEST_STDLIB_LOGGER' )
208+
194209
call global % configure( add_blank_line=.false., indent=.true., &
195210
max_width=72, time_stamp=.true. )
196211

@@ -202,6 +217,14 @@ subroutine test_logging_configuration()
202217
module = 'N/A', &
203218
procedure = 'TEST_STDLIB_LOGGER' )
204219

220+
call global % log_message( 'The last word of the first line ' // &
221+
new_line('a')//'should be "the". "Line"' // new_line('a') // &
222+
'should be the last word for the second line. The following ' // &
223+
'lines should be limited to 72 columns width. From the second ' //&
224+
'line, all lines should be indented by 4 columns.' ,&
225+
module = 'N/A', &
226+
procedure = 'TEST_STDLIB_LOGGER' )
227+
205228
end subroutine test_logging_configuration
206229

207230

0 commit comments

Comments
 (0)