glob(3f) - [fpm_strings:COMPARE] compare given string for match to
pattern which may contain wildcard characters
(LICENSE:PD)
logical function glob(string, pattern )
character(len=*),intent(in) :: string
character(len=*),intent(in) :: pattern
glob(3f) compares given STRING for match to PATTERN which may contain wildcard characters.
In this version to get a match the entire string must be described by PATTERN. Trailing whitespace is significant, so trim the input string to have trailing whitespace ignored.
string the input string to test to see if it contains the pattern.
pattern the following simple globbing options are available
o "?" matching any one character
o "*" matching zero or more characters.
Do NOT use adjacent asterisks.
o Both strings may have trailing spaces which
are ignored.
o There is no escape character, so matching strings with
literal question mark and asterisk is problematic.
Example program
program demo_glob
implicit none
! This main() routine passes a bunch of test strings
! into the above code. In performance comparison mode,
! it does that over and over. Otherwise, it does it just
! once. Either way, it outputs a passed/failed result.
!
integer :: nReps
logical :: allpassed
integer :: i
allpassed = .true.
nReps = 10000
! Can choose as many repetitions as you're expecting
! in the real world.
nReps = 1
do i=1,nReps
! Cases with repeating character sequences.
allpassed=allpassed .and. test("a*abab", "a*b", .true.)
!!cycle
allpassed=allpassed .and. test("ab", "*?", .true.)
allpassed=allpassed .and. test("abc", "*?", .true.)
allpassed=allpassed .and. test("abcccd", "*ccd", .true.)
allpassed=allpassed .and. test("bLah", "bLaH", .false.)
allpassed=allpassed .and. test("mississippi", "*sip*", .true.)
allpassed=allpassed .and. &
& test("xxxx*zzzzzzzzy*f", "xxx*zzy*f", .true.)
allpassed=allpassed .and. &
& test("xxxx*zzzzzzzzy*f", "xxxx*zzy*fffff", .false.)
allpassed=allpassed .and. &
& test("mississipissippi", "*issip*ss*", .true.)
allpassed=allpassed .and. &
& test("xxxxzzzzzzzzyf", "xxxx*zzy*fffff", .false.)
allpassed=allpassed .and. &
& test("xxxxzzzzzzzzyf", "xxxx*zzy*f", .true.)
allpassed=allpassed .and. test("xyxyxyzyxyz", "xy*z*xyz", .true.)
allpassed=allpassed .and. test("xyxyxyxyz", "xy*xyz", .true.)
allpassed=allpassed .and. test("mississippi", "mi*sip*", .true.)
allpassed=allpassed .and. test("ababac", "*abac*", .true.)
allpassed=allpassed .and. test("aaazz", "a*zz*", .true.)
allpassed=allpassed .and. test("a12b12", "*12*23", .false.)
allpassed=allpassed .and. test("a12b12", "a12b", .false.)
allpassed=allpassed .and. test("a12b12", "*12*12*", .true.)
! Additional cases where the '*' char appears in the tame string.
allpassed=allpassed .and. test("*", "*", .true.)
allpassed=allpassed .and. test("a*r", "a*", .true.)
allpassed=allpassed .and. test("a*ar", "a*aar", .false.)
! More double wildcard scenarios.
allpassed=allpassed .and. test("XYXYXYZYXYz", "XY*Z*XYz", .true.)
allpassed=allpassed .and. test("missisSIPpi", "*SIP*", .true.)
allpassed=allpassed .and. test("mississipPI", "*issip*PI", .true.)
allpassed=allpassed .and. test("xyxyxyxyz", "xy*xyz", .true.)
allpassed=allpassed .and. test("miSsissippi", "mi*sip*", .true.)
allpassed=allpassed .and. test("miSsissippi", "mi*Sip*", .false.)
allpassed=allpassed .and. test("abAbac", "*Abac*", .true.)
allpassed=allpassed .and. test("aAazz", "a*zz*", .true.)
allpassed=allpassed .and. test("A12b12", "*12*23", .false.)
allpassed=allpassed .and. test("a12B12", "*12*12*", .true.)
allpassed=allpassed .and. test("oWn", "*oWn*", .true.)
! Completely tame (no wildcards) cases.
allpassed=allpassed .and. test("bLah", "bLah", .true.)
! Simple mixed wildcard tests suggested by IBMer Marlin Deckert.
allpassed=allpassed .and. test("a", "*?", .true.)
! More mixed wildcard tests including coverage for false positives.
allpassed=allpassed .and. test("a", "??", .false.)
allpassed=allpassed .and. test("ab", "?*?", .true.)
allpassed=allpassed .and. test("ab", "*?*?*", .true.)
allpassed=allpassed .and. test("abc", "?**?*?", .true.)
allpassed=allpassed .and. test("abc", "?**?*&?", .false.)
allpassed=allpassed .and. test("abcd", "?b*??", .true.)
allpassed=allpassed .and. test("abcd", "?a*??", .false.)
allpassed=allpassed .and. test("abcd", "?**?c?", .true.)
allpassed=allpassed .and. test("abcd", "?**?d?", .false.)
allpassed=allpassed .and. test("abcde", "?*b*?*d*?", .true.)
! Single-character-match cases.
allpassed=allpassed .and. test("bLah", "bL?h", .true.)
allpassed=allpassed .and. test("bLaaa", "bLa?", .false.)
allpassed=allpassed .and. test("bLah", "bLa?", .true.)
allpassed=allpassed .and. test("bLaH", "?Lah", .false.)
allpassed=allpassed .and. test("bLaH", "?LaH", .true.)
! Many-wildcard scenarios.
allpassed=allpassed .and. test(&
&"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa&
&aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaab",&
&"a*a*a*a*a*a*aa*aaa*a*a*b",&
&.true.)
allpassed=allpassed .and. test(&
&"abababababababababababababababababababaacacacacacacac&
&adaeafagahaiajakalaaaaaaaaaaaaaaaaaffafagaagggagaaaaaaaab",&
&"*a*b*ba*ca*a*aa*aaa*fa*ga*b*",&
&.true.)
allpassed=allpassed .and. test(&
&"abababababababababababababababababababaacacacacacaca&
&cadaeafagahaiajakalaaaaaaaaaaaaaaaaaffafagaagggagaaaaaaaab",&
&"*a*b*ba*ca*a*x*aaa*fa*ga*b*",&
&.false.)
allpassed=allpassed .and. test(&
&"abababababababababababababababababababaacacacacacacacad&
&aeafagahaiajakalaaaaaaaaaaaaaaaaaffafagaagggagaaaaaaaab",&
&"*a*b*ba*ca*aaaa*fa*ga*gggg*b*",&
&.false.)
allpassed=allpassed .and. test(&
&"abababababababababababababababababababaacacacacacacacad&
&aeafagahaiajakalaaaaaaaaaaaaaaaaaffafagaagggagaaaaaaaab",&
&"*a*b*ba*ca*aaaa*fa*ga*ggg*b*",&
&.true.)
allpassed=allpassed .and. test("aaabbaabbaab", "*aabbaa*a*", .true.)
allpassed=allpassed .and. &
test("a*a*a*a*a*a*a*a*a*a*a*a*a*a*a*a*a*",&
&"a*a*a*a*a*a*a*a*a*a*a*a*a*a*a*a*a*", .true.)
allpassed=allpassed .and. test("aaaaaaaaaaaaaaaaa",&
&"*a*a*a*a*a*a*a*a*a*a*a*a*a*a*a*a*a*", .true.)
allpassed=allpassed .and. test("aaaaaaaaaaaaaaaa",&
&"*a*a*a*a*a*a*a*a*a*a*a*a*a*a*a*a*a*", .false.)
allpassed=allpassed .and. test(&
&"abc*abcd*abcde*abcdef*abcdefg*abcdefgh*abcdefghi*abcdefghij&
&*abcdefghijk*abcdefghijkl*abcdefghijklm*abcdefghijklmn",&
& "abc*abc*abc*abc*abc*abc*abc*abc*abc*abc*abc*abc*abc*abc&
&*abc*abc*abc*",&
&.false.)
allpassed=allpassed .and. test(&
&"abc*abcd*abcde*abcdef*abcdefg*abcdefgh*abcdefghi*abcdefghij&
&*abcdefghijk*abcdefghijkl*abcdefghijklm*abcdefghijklmn",&
&"abc*abc*abc*abc*abc*abc*abc*abc*abc*abc*abc*abc*",&
&.true.)
allpassed=allpassed .and. test("abc*abcd*abcd*abc*abcd",&
&"abc*abc*abc*abc*abc", .false.)
allpassed=allpassed .and. test( "abc*abcd*abcd*abc*abcd*abcd&
&*abc*abcd*abc*abc*abcd", &
&"abc*abc*abc*abc*abc*abc*abc*abc*abc*abc*abcd",&
&.true.)
allpassed=allpassed .and. test("abc",&
&"********a********b********c********", .true.)
allpassed=allpassed .and.&
&test("********a********b********c********", "abc", .false.)
allpassed=allpassed .and. &
&test("abc", "********a********b********b********", .false.)
allpassed=allpassed .and. test("*abc*", "***a*b*c***", .true.)
! A case-insensitive algorithm test.
! allpassed=allpassed .and. test("mississippi", "*issip*PI", .true.)
enddo
if (allpassed)then
write(*,'(a)')"Passed",nReps
else
write(*,'(a)')"Failed"
endif
contains
! This is a test program for wildcard matching routines.
! It can be used either to test a single routine for correctness,
! or to compare the timings of two (or more) different wildcard
! matching routines.
!
function test(tame, wild, bExpectedResult) result(bpassed)
use fpm_strings, only : glob
character(len=*) :: tame
character(len=*) :: wild
logical :: bExpectedResult
logical :: bResult
logical :: bPassed
bResult = .true. ! We'll do "&=" cumulative checking.
bPassed = .false. ! Assume the worst.
write(*,*)repeat('=',79)
bResult = glob(tame, wild) ! Call a wildcard matching routine.
! To assist correctness checking, output the two strings in any
! failing scenarios.
if (bExpectedResult .eqv. bResult) then
bPassed = .true.
if(nReps == 1) write(*,*)"Passed match on ",tame," vs. ", wild
else
if(nReps == 1) write(*,*)"Failed match on ",tame," vs. ", wild
endif
end function test
end program demo_glob
Expected output
The article “Matching Wildcards: An Empirical Way to Tame an Algorithm” in Dr Dobb’s Journal, By Kirk J. Krauss, October 07, 2014
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| character(len=*) | :: | tame |
A string without wildcards to compare to the globbing expression |
|||
| character(len=*) | :: | wild |
A (potentially) corresponding string with wildcards |
result of test
function glob(tame,wild)
! @(#)fpm_strings::glob(3f): function compares text strings, one of which can have wildcards ('*' or '?').
logical :: glob !! result of test
character(len=*) :: tame !! A string without wildcards to compare to the globbing expression
character(len=*) :: wild !! A (potentially) corresponding string with wildcards
character(len=len(tame)+1) :: tametext
character(len=len(wild)+1) :: wildtext
character(len=1),parameter :: NULL=char(0)
integer :: wlen
integer :: ti, wi
integer :: i
character(len=:),allocatable :: tbookmark, wbookmark
! These two values are set when we observe a wildcard character. They
! represent the locations, in the two strings, from which we start once we've observed it.
tametext=tame//NULL
wildtext=wild//NULL
tbookmark = NULL
wbookmark = NULL
wlen=len(wild)
wi=1
ti=1
do ! Walk the text strings one character at a time.
if(wildtext(wi:wi) == '*')then ! How do you match a unique text string?
do i=wi,wlen ! Easy: unique up on it!
if(wildtext(wi:wi)=='*')then
wi=wi+1
else
exit
endif
enddo
if(wildtext(wi:wi)==NULL) then ! "x" matches "*"
glob=.true.
return
endif
if(wildtext(wi:wi) /= '?') then
! Fast-forward to next possible match.
do while (tametext(ti:ti) /= wildtext(wi:wi))
ti=ti+1
if (tametext(ti:ti)==NULL)then
glob=.false.
return ! "x" doesn't match "*y*"
endif
enddo
endif
wbookmark = wildtext(wi:)
tbookmark = tametext(ti:)
elseif(tametext(ti:ti) /= wildtext(wi:wi) .and. wildtext(wi:wi) /= '?') then
! Got a non-match. If we've set our bookmarks, back up to one or both of them and retry.
if(wbookmark/=NULL) then
if(wildtext(wi:)/= wbookmark) then
wildtext = wbookmark;
wlen=len_trim(wbookmark)
wi=1
! Don't go this far back again.
if (tametext(ti:ti) /= wildtext(wi:wi)) then
tbookmark=tbookmark(2:)
tametext = tbookmark
ti=1
cycle ! "xy" matches "*y"
else
wi=wi+1
endif
endif
if (tametext(ti:ti)/=NULL) then
ti=ti+1
cycle ! "mississippi" matches "*sip*"
endif
endif
glob=.false.
return ! "xy" doesn't match "x"
endif
ti=ti+1
wi=wi+1
if (tametext(ti:ti)==NULL) then ! How do you match a tame text string?
if(wildtext(wi:wi)/=NULL)then
do while (wildtext(wi:wi) == '*') ! The tame way: unique up on it!
wi=wi+1 ! "x" matches "x*"
if(wildtext(wi:wi)==NULL)exit
enddo
endif
if (wildtext(wi:wi)==NULL)then
glob=.true.
return ! "x" matches "x"
endif
glob=.false.
return ! "x" doesn't match "xy"
endif
enddo
end function glob