@@ -77,9 +77,7 @@ module stdlib_logger
77
77
private
78
78
79
79
logical :: add_blank_line = .false.
80
- character (:), allocatable :: buffer
81
80
logical :: indent_lines = .true.
82
- integer :: len_buffer = 0
83
81
integer , allocatable :: log_units(:)
84
82
integer :: max_width = 0
85
83
logical :: time_stamp = .true.
@@ -517,22 +515,24 @@ subroutine final_logger( self )
517
515
end subroutine final_logger
518
516
519
517
520
- subroutine format_output_string ( self , string , col_indent )
518
+ subroutine format_output_string ( self , string , col_indent , len_buffer , buffer )
521
519
! ! version: experimental
522
520
523
521
! ! Writes the STRING to UNIT ensuring that the number of characters
524
522
! ! does not exceed MAX_WIDTH and that the lines after the first
525
523
! ! one are indented four characters.
526
- class(logger_type), intent (inout ) :: self
527
- character (* ), intent (in ) :: string
528
- character (* ), intent (in ) :: col_indent
524
+ class(logger_type), intent (inout ) :: self
525
+ integer , intent (out ) :: len_buffer
526
+ character (* ), intent (in ) :: string
527
+ character (* ), intent (in ) :: col_indent
528
+ character (len= :), allocatable , intent (out ) :: buffer
529
529
530
530
integer :: count, indent_len, index_, length, remain
531
531
integer , parameter :: new_len = len (new_line(' a' ))
532
532
533
533
length = len_trim (string)
534
- allocate ( character (2 * length) :: self % buffer )
535
- self % len_buffer = 0
534
+ allocate ( character (2 * length) :: buffer )
535
+ len_buffer = 0
536
536
indent_len = len (col_indent)
537
537
call format_first_line()
538
538
@@ -553,8 +553,8 @@ subroutine format_first_line()
553
553
if ( self % max_width == 0 .or. &
554
554
( length <= self % max_width .and. &
555
555
index ( string (1 :length), new_line(' a' )) == 0 ) ) then
556
- self % buffer(1 :length) = string (1 :length)
557
- self % len_buffer = length
556
+ buffer(1 :length) = string (1 :length)
557
+ len_buffer = length
558
558
remain = 0
559
559
return
560
560
else
@@ -568,15 +568,15 @@ subroutine format_first_line()
568
568
end if
569
569
570
570
if ( index_ == 0 ) then
571
- self % buffer(1 :self % max_width) = &
571
+ buffer(1 :self % max_width) = &
572
572
string (1 :self % max_width)
573
- self % len_buffer = self % max_width
573
+ len_buffer = self % max_width
574
574
count = self % max_width
575
575
remain = length - count
576
576
return
577
577
else
578
- self % buffer(1 :index_-1 ) = string (1 :index_-1 )
579
- self % len_buffer = index_-1
578
+ buffer(1 :index_-1 ) = string (1 :index_-1 )
579
+ len_buffer = index_-1
580
580
count = index_
581
581
remain = length - count
582
582
return
@@ -591,15 +591,15 @@ subroutine format_subsequent_line()
591
591
character (:), allocatable :: dummy
592
592
593
593
if ( remain <= self % max_width ) then
594
- new_len_buffer = self % len_buffer + length - count + new_len
595
- if ( new_len_buffer > len ( self % buffer ) ) then
596
- allocate ( character ( 2 * len ( self % buffer ) ) :: dummy )
597
- dummy = self % buffer
598
- call move_alloc( dummy, self % buffer )
594
+ new_len_buffer = len_buffer + length - count + new_len
595
+ if ( new_len_buffer > len ( buffer ) ) then
596
+ allocate ( character ( 2 * len ( buffer ) ) :: dummy )
597
+ dummy = buffer
598
+ call move_alloc( dummy, buffer )
599
599
end if
600
- self % buffer( self % len_buffer+1 :new_len_buffer ) = &
600
+ buffer( len_buffer+1 :new_len_buffer ) = &
601
601
new_line(' a' ) // string (count+1 :length)
602
- self % len_buffer = new_len_buffer
602
+ len_buffer = new_len_buffer
603
603
count = length
604
604
remain = 0
605
605
return
@@ -614,30 +614,30 @@ subroutine format_subsequent_line()
614
614
end if
615
615
616
616
if ( index_ == count ) then
617
- new_len_buffer = self % len_buffer + self % max_width + &
617
+ new_len_buffer = len_buffer + self % max_width + &
618
618
new_len
619
- if ( new_len_buffer > len ( self % buffer ) ) then
620
- allocate ( character ( 2 * len ( self % buffer ) ) :: dummy )
621
- dummy = self % buffer
622
- call move_alloc( dummy, self % buffer )
619
+ if ( new_len_buffer > len ( buffer ) ) then
620
+ allocate ( character ( 2 * len ( buffer ) ) :: dummy )
621
+ dummy = buffer
622
+ call move_alloc( dummy, buffer )
623
623
end if
624
- self % buffer( self % len_buffer+1 :new_len_buffer ) = &
624
+ buffer( len_buffer+1 :new_len_buffer ) = &
625
625
new_line(' a' ) // string (count+1 :count+ self % max_width)
626
- self % len_buffer = new_len_buffer
626
+ len_buffer = new_len_buffer
627
627
count = count + self % max_width
628
628
remain = length - count
629
629
return
630
630
else
631
- new_len_buffer = self % len_buffer + index_ - 1 &
631
+ new_len_buffer = len_buffer + index_ - 1 &
632
632
- count + new_len
633
- if ( new_len_buffer > len ( self % buffer ) ) then
634
- allocate ( character ( 2 * len ( self % buffer ) ) :: dummy )
635
- dummy = self % buffer
636
- call move_alloc( dummy, self % buffer )
633
+ if ( new_len_buffer > len ( buffer ) ) then
634
+ allocate ( character ( 2 * len ( buffer ) ) :: dummy )
635
+ dummy = buffer
636
+ call move_alloc( dummy, buffer )
637
637
end if
638
- self % buffer( self % len_buffer+1 :new_len_buffer ) = &
638
+ buffer( len_buffer+1 :new_len_buffer ) = &
639
639
new_line(' a' ) // string (count+1 :index_-1 )
640
- self % len_buffer = new_len_buffer
640
+ len_buffer = new_len_buffer
641
641
count = index_
642
642
remain = length - count
643
643
return
@@ -653,16 +653,16 @@ subroutine indent_format_subsequent_line()
653
653
654
654
if ( index ( string (count+1 :length), new_line(' a' )) == 0 .and. &
655
655
remain <= self % max_width - indent_len ) then
656
- new_len_buffer = self % len_buffer + length &
656
+ new_len_buffer = len_buffer + length &
657
657
- count + new_len + indent_len
658
- if ( new_len_buffer > len ( self % buffer ) ) then
659
- allocate ( character ( 2 * len ( self % buffer ) ) :: dummy )
660
- dummy = self % buffer
661
- call move_alloc( dummy, self % buffer )
658
+ if ( new_len_buffer > len ( buffer ) ) then
659
+ allocate ( character ( 2 * len ( buffer ) ) :: dummy )
660
+ dummy = buffer
661
+ call move_alloc( dummy, buffer )
662
662
end if
663
- self % buffer( self % len_buffer+1 :new_len_buffer ) = &
663
+ buffer( len_buffer+1 :new_len_buffer ) = &
664
664
new_line(' a' ) // col_indent // string (count+1 :length)
665
- self % len_buffer = new_len_buffer
665
+ len_buffer = new_len_buffer
666
666
count = length
667
667
remain = 0
668
668
return
@@ -678,31 +678,31 @@ subroutine indent_format_subsequent_line()
678
678
end if
679
679
680
680
if ( index_ == count ) then
681
- new_len_buffer = self % len_buffer + self % max_width &
681
+ new_len_buffer = len_buffer + self % max_width &
682
682
+ new_len
683
- if ( new_len_buffer > len ( self % buffer ) ) then
684
- allocate ( character ( 2 * len ( self % buffer ) ) :: dummy )
685
- dummy = self % buffer
686
- call move_alloc( dummy, self % buffer )
683
+ if ( new_len_buffer > len ( buffer ) ) then
684
+ allocate ( character ( 2 * len ( buffer ) ) :: dummy )
685
+ dummy = buffer
686
+ call move_alloc( dummy, buffer )
687
687
end if
688
- self % buffer( self % len_buffer+1 : new_len_buffer ) = &
688
+ buffer( len_buffer+1 : new_len_buffer ) = &
689
689
new_line(' a' ) // col_indent // &
690
690
string (count+1 :count+ self % max_width- indent_len)
691
- self % len_buffer = new_len_buffer
691
+ len_buffer = new_len_buffer
692
692
count = count + self % max_width - indent_len
693
693
remain = length - count
694
694
return
695
695
else
696
- new_len_buffer = self % len_buffer + index_ - count - 1 &
696
+ new_len_buffer = len_buffer + index_ - count - 1 &
697
697
+ new_len + indent_len
698
- if ( new_len_buffer > len ( self % buffer ) ) then
699
- allocate ( character ( 2 * len ( self % buffer ) ) :: dummy )
700
- dummy = self % buffer
701
- call move_alloc( dummy, self % buffer )
698
+ if ( new_len_buffer > len ( buffer ) ) then
699
+ allocate ( character ( 2 * len ( buffer ) ) :: dummy )
700
+ dummy = buffer
701
+ call move_alloc( dummy, buffer )
702
702
end if
703
- self % buffer( self % len_buffer+1 : new_len_buffer ) = &
703
+ buffer( len_buffer+1 : new_len_buffer ) = &
704
704
new_line(' a' ) // col_indent // string (count+1 :index_-1 )
705
- self % len_buffer = new_len_buffer
705
+ len_buffer = new_len_buffer
706
706
count = index_
707
707
remain = length - count
708
708
return
@@ -1040,9 +1040,11 @@ subroutine log_message( self, message, module, procedure, prefix )
1040
1040
1041
1041
integer :: unit
1042
1042
integer :: iostat
1043
+ integer :: len_buffer
1043
1044
character (* ), parameter :: procedure_name = ' log_message'
1044
1045
character (256 ) :: iomsg
1045
1046
character (:), allocatable :: d_and_t, m_and_p, pref
1047
+ character (:), allocatable :: buffer
1046
1048
1047
1049
if ( present (prefix) ) then
1048
1050
pref = prefix // ' : '
@@ -1071,36 +1073,38 @@ subroutine log_message( self, message, module, procedure, prefix )
1071
1073
call format_output_string( self, &
1072
1074
d_and_t // m_and_p // pref // &
1073
1075
trim ( message ), &
1074
- ' ' )
1076
+ ' ' , &
1077
+ len_buffer, &
1078
+ buffer)
1075
1079
1076
1080
if ( self % units == 0 ) then
1077
1081
if ( self % add_blank_line ) then
1078
1082
write ( output_unit, ' (a)' , err= 999 , iostat= iostat, &
1079
1083
iomsg= iomsg) &
1080
- new_line(' a' ) // self % buffer(1 :self % len_buffer)
1084
+ new_line(' a' ) // buffer(1 :len_buffer)
1081
1085
else
1082
1086
write ( output_unit, ' (a)' , err= 999 , iostat= iostat, &
1083
1087
iomsg= iomsg ) &
1084
- self % buffer(1 :self % len_buffer)
1088
+ buffer(1 :len_buffer)
1085
1089
end if
1086
1090
else
1087
1091
if ( self % add_blank_line ) then
1088
1092
do unit= 1 , self % units
1089
1093
write ( self % log_units(unit), ' (a)' , err= 999 , iostat= iostat, &
1090
1094
iomsg= iomsg ) new_line(' a' ) // &
1091
- self % buffer(1 :self % len_buffer)
1095
+ buffer(1 :len_buffer)
1092
1096
end do
1093
1097
else
1094
1098
do unit= 1 , self % units
1095
1099
write ( self % log_units(unit), ' (a)' , err= 999 , iostat= iostat, &
1096
1100
iomsg= iomsg ) &
1097
- self % buffer(1 :self % len_buffer)
1101
+ buffer(1 :len_buffer)
1098
1102
end do
1099
1103
end if
1100
1104
end if
1101
1105
1102
- deallocate ( self % buffer )
1103
- self % len_buffer = 0
1106
+ deallocate ( buffer )
1107
+ len_buffer = 0
1104
1108
1105
1109
return
1106
1110
@@ -1169,11 +1173,12 @@ subroutine log_text_error( self, line, column, summary, filename, &
1169
1173
! ! greater than `len(line)`, and `write_failure` if any of the `write`
1170
1174
! ! statements has failed.
1171
1175
1172
- character (1 ) :: acaret
1173
- character (128 ) :: iomsg
1174
- integer :: iostat
1175
- integer :: lun
1176
- character (* ), parameter :: procedure_name = ' LOG_TEXT_ERROR'
1176
+ character (1 ) :: acaret
1177
+ character (128 ) :: iomsg
1178
+ integer :: iostat
1179
+ integer :: lun
1180
+ character (* ), parameter :: procedure_name = ' LOG_TEXT_ERROR'
1181
+ character (len= :), allocatable :: buffer
1177
1182
1178
1183
acaret = optval(caret, ' ^' )
1179
1184
@@ -1192,14 +1197,13 @@ subroutine log_text_error( self, line, column, summary, filename, &
1192
1197
1193
1198
call write_log_text_error_buffer( )
1194
1199
if ( self % units == 0 ) then
1195
- write ( output_unit, ' (a)' ) self % buffer
1200
+ write ( output_unit, ' (a)' ) buffer
1196
1201
else
1197
1202
do lun= 1 , self % units
1198
- write ( self % log_units(lun), ' (a)' ) self % buffer
1203
+ write ( self % log_units(lun), ' (a)' ) buffer
1199
1204
end do
1200
1205
end if
1201
- deallocate ( self % buffer )
1202
- self % len_buffer = 0
1206
+ deallocate ( buffer )
1203
1207
1204
1208
contains
1205
1209
@@ -1243,26 +1247,26 @@ subroutine write_log_text_error_buffer( )
1243
1247
marker(column:column) = acaret
1244
1248
if ( self % add_blank_line ) then
1245
1249
if ( self % time_stamp ) then
1246
- self % buffer = new_line(' a' ) // time_stamp() // &
1250
+ buffer = new_line(' a' ) // time_stamp() // &
1247
1251
new_line(' a' ) // trim (location) // &
1248
1252
new_line(' a' ) // new_line(' a' ) // trim (line) // &
1249
1253
new_line(' a' ) // marker // &
1250
1254
new_line(' a' ) // ' Error: ' // trim (summary)
1251
1255
else
1252
- self % buffer = new_line(' a' ) // trim (location) // &
1256
+ buffer = new_line(' a' ) // trim (location) // &
1253
1257
new_line(' a' ) // new_line(' a' ) // trim (line) // &
1254
1258
new_line(' a' ) // marker // &
1255
1259
new_line(' a' ) // ' Error: ' // trim (summary)
1256
1260
end if
1257
1261
else
1258
1262
if ( self % time_stamp ) then
1259
- self % buffer = time_stamp() // &
1263
+ buffer = time_stamp() // &
1260
1264
new_line(' a' ) // trim (location) // &
1261
1265
new_line(' a' ) // new_line(' a' ) // trim (line) // &
1262
1266
new_line(' a' ) // marker // &
1263
1267
new_line(' a' ) // ' Error: ' // trim (summary)
1264
1268
else
1265
- self % buffer = trim (location) // &
1269
+ buffer = trim (location) // &
1266
1270
new_line(' a' ) // new_line(' a' ) // trim (line) // &
1267
1271
new_line(' a' ) // marker // &
1268
1272
new_line(' a' ) // ' Error: ' // trim (summary)
0 commit comments