Skip to content

Commit 0560c74

Browse files
authored
correct join for null input (#404)
If the input string is null join would overindex by using element one when adding the left and right strings. This corrects that.
1 parent 588a79e commit 0560c74

File tree

1 file changed

+55
-60
lines changed

1 file changed

+55
-60
lines changed

fpm/src/fpm_strings.f90

Lines changed: 55 additions & 60 deletions
Original file line numberDiff line numberDiff line change
@@ -431,12 +431,13 @@ end subroutine resize_string
431431

432432
!>AUTHOR: John S. Urban
433433
!!LICENSE: Public Domain
434-
!!## NAME
435-
!! join(3f) - [fpm_strings:EDITING] append CHARACTER variable array into
434+
!>
435+
!!##NAME
436+
!! join(3f) - [M_strings:EDITING] append CHARACTER variable array into
436437
!! a single CHARACTER variable with specified separator
437438
!! (LICENSE:PD)
438439
!!
439-
!!## SYNOPSIS
440+
!!##SYNOPSIS
440441
!!
441442
!! pure function join(str,sep,trm,left,right,start,end) result (string)
442443
!!
@@ -449,13 +450,13 @@ end subroutine resize_string
449450
!! character(len=*),intent(in),optional :: end
450451
!! character(len=:),allocatable :: string
451452
!!
452-
!!## DESCRIPTION
453+
!!##DESCRIPTION
453454
!! JOIN(3f) appends the elements of a CHARACTER array into a single
454455
!! CHARACTER variable, with elements 1 to N joined from left to right.
455456
!! By default each element is trimmed of trailing spaces and the
456457
!! default separator is a null string.
457458
!!
458-
!!## OPTIONS
459+
!!##OPTIONS
459460
!! STR(:) array of CHARACTER variables to be joined
460461
!! SEP separator string to place between each variable. defaults
461462
!! to a null string.
@@ -466,81 +467,75 @@ end subroutine resize_string
466467
!! TRM option to trim each element of STR of trailing
467468
!! spaces. Defaults to .TRUE.
468469
!!
469-
!!## RESULT
470+
!!##RESULT
470471
!! STRING CHARACTER variable composed of all of the elements of STR()
471472
!! appended together with the optional separator SEP placed
472473
!! between the elements.
473474
!!
474-
!!## EXAMPLE
475+
!!##EXAMPLE
475476
!!
476477
!! Sample program:
477-
!!```fortran
478-
!! program demo_join
479-
!! use fpm_strings, only: join
480-
!! implicit none
481-
!! character(len=:),allocatable :: s(:)
482-
!! character(len=:),allocatable :: out
483-
!! integer :: i
484-
!! s=[character(len=10) :: 'United',' we',' stand,', &
485-
!! & ' divided',' we fall.']
486-
!! out=join(s)
487-
!! write(*,'(a)') out
488-
!! write(*,'(a)') join(s,trm=.false.)
489-
!! write(*,'(a)') (join(s,trm=.false.,sep='|'),i=1,3)
490-
!! write(*,'(a)') join(s,sep='<>')
491-
!! write(*,'(a)') join(s,sep=';',left='[',right=']')
492-
!! write(*,'(a)') join(s,left='[',right=']')
493-
!! write(*,'(a)') join(s,left='>>')
494-
!! end program demo_join
495-
!!```fortran
496478
!!
497-
!! Expected output:
479+
!! program demo_join
480+
!! use M_strings, only: join
481+
!! implicit none
482+
!! character(len=:),allocatable :: s(:)
483+
!! character(len=:),allocatable :: out
484+
!! integer :: i
485+
!! s=[character(len=10) :: 'United',' we',' stand,', &
486+
!! & ' divided',' we fall.']
487+
!! out=join(s)
488+
!! write(*,'(a)') out
489+
!! write(*,'(a)') join(s,trm=.false.)
490+
!! write(*,'(a)') (join(s,trm=.false.,sep='|'),i=1,3)
491+
!! write(*,'(a)') join(s,sep='<>')
492+
!! write(*,'(a)') join(s,sep=';',left='[',right=']')
493+
!! write(*,'(a)') join(s,left='[',right=']')
494+
!! write(*,'(a)') join(s,left='>>')
495+
!! end program demo_join
498496
!!
499-
!! United we stand, divided we fall.
500-
!! United we stand, divided we fall.
501-
!! United | we | stand, | divided | we fall.
502-
!! United | we | stand, | divided | we fall.
503-
!! United | we | stand, | divided | we fall.
504-
!! United<> we<> stand,<> divided<> we fall.
505-
!! [United];[ we];[ stand,];[ divided];[ we fall.]
506-
!! [United][ we][ stand,][ divided][ we fall.]
507-
!! >>United>> we>> stand,>> divided>> we fall.
497+
!! Expected output:
508498
!!
499+
!! United we stand, divided we fall.
500+
!! United we stand, divided we fall.
501+
!! United | we | stand, | divided | we fall.
502+
!! United | we | stand, | divided | we fall.
503+
!! United | we | stand, | divided | we fall.
504+
!! United<> we<> stand,<> divided<> we fall.
505+
!! [United];[ we];[ stand,];[ divided];[ we fall.]
506+
!! [United][ we][ stand,][ divided][ we fall.]
507+
!! >>United>> we>> stand,>> divided>> we fall.
509508
pure function join(str,sep,trm,left,right,start,end) result (string)
510509

511-
! @(#)join(3f): append an array of character variables with specified separator into a single CHARACTER variable
510+
! @(#)M_strings::join(3f): merge string array into a single CHARACTER value adding specified separators, caps, prefix and suffix
512511

513512
character(len=*),intent(in) :: str(:)
514-
character(len=*),intent(in),optional :: sep
515-
character(len=*),intent(in),optional :: right
516-
character(len=*),intent(in),optional :: left
517-
character(len=*),intent(in),optional :: start
518-
character(len=*),intent(in),optional :: end
513+
character(len=*),intent(in),optional :: sep, right, left, start, end
519514
logical,intent(in),optional :: trm
515+
character(len=:),allocatable :: sep_local, left_local, right_local
520516
character(len=:),allocatable :: string
521-
integer :: i
522517
logical :: trm_local
523-
character(len=:),allocatable :: sep_local
524-
character(len=:),allocatable :: left_local
525-
character(len=:),allocatable :: right_local
526-
527-
if(present(sep))then ; sep_local=sep ; else ; sep_local='' ; endif
528-
if(present(trm))then ; trm_local=trm ; else ; trm_local=.true. ; endif
529-
if(present(left))then ; left_local=left ; else ; left_local='' ; endif
530-
if(present(right))then ; right_local=right ; else ; right_local='' ; endif
531-
518+
integer :: i
519+
if(present(sep))then ; sep_local=sep ; else ; sep_local='' ; endif
520+
if(present(trm))then ; trm_local=trm ; else ; trm_local=.true. ; endif
521+
if(present(left))then ; left_local=left ; else ; left_local='' ; endif
522+
if(present(right))then ; right_local=right ; else ; right_local='' ; endif
532523
string=''
533-
do i = 1,size(str)-1
524+
if(size(str).eq.0)then
525+
string=string//left_local//right_local
526+
else
527+
do i = 1,size(str)-1
528+
if(trm_local)then
529+
string=string//left_local//trim(str(i))//right_local//sep_local
530+
else
531+
string=string//left_local//str(i)//right_local//sep_local
532+
endif
533+
enddo
534534
if(trm_local)then
535-
string=string//left_local//trim(str(i))//right_local//sep_local
535+
string=string//left_local//trim(str(i))//right_local
536536
else
537-
string=string//left_local//str(i)//right_local//sep_local
537+
string=string//left_local//str(i)//right_local
538538
endif
539-
enddo
540-
if(trm_local)then
541-
string=string//left_local//trim(str(i))//right_local
542-
else
543-
string=string//left_local//str(i)//right_local
544539
endif
545540
if(present(start))string=start//string
546541
if(present(end))string=string//end

0 commit comments

Comments
 (0)