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