fnmatch C function wrapper via FFI added
The XDG Shared MIME-info Database spec states that "the format of the glob pattern is as for fnmatch(3)".[0] So, here it is. [0]: http://standards.freedesktop.org/shared-mime-info-spec\ /shared-mime-info-spec-latest.html (retrieved 17 Nov 2014).master
parent
becf9f1b3f
commit
33d702bad4
|
@ -0,0 +1,64 @@
|
|||
;; fnmatch C library function via FFI
|
||||
;;
|
||||
;; Copyright (C) 2014 Mike Gerwitz
|
||||
;;
|
||||
;; This file is part of guile-mime.
|
||||
;;
|
||||
;; guile-mime is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published
|
||||
;; by the Free Software Foundation, either version 3 of the License,
|
||||
;; or (at your option) any later version.
|
||||
;;
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
|
||||
|
||||
(define-module (mime fnmatch)
|
||||
#:use-module (system foreign)
|
||||
#:export (fnmatch))
|
||||
|
||||
|
||||
|
||||
(define* (fnmatch pattern string
|
||||
#:key (case-fold #f)
|
||||
(allow-error #f))
|
||||
"Check whether @var{string} matches the shell wildcard pattern
|
||||
@var{pattern}. This is a wrapper around the C function `fnmatch'; see
|
||||
fnmatch(3) for more information.
|
||||
|
||||
The key @var{case-fold} is equivalent to the C flag
|
||||
@var{FNM_CASEFOLD}: it will perform a case-insensitive match. The
|
||||
default behavior is to perform no case folding.
|
||||
|
||||
POSIX does not define any conditions under which `fnmatch' may fail,
|
||||
and glibc guarantees that an error condition will not occur. The
|
||||
default behavior of this procedure is therefore to ignore any error
|
||||
conditions; if you do not like this, set @var{allow-error}, which
|
||||
will cause an error to be raised when the underlying `fnmatch` call
|
||||
fails to return a boolean result."
|
||||
(define FNM_NOMATCH 1)
|
||||
(define FNM_CASEFOLD (ash 1 4))
|
||||
(define %c-fnmatch (pointer->procedure int
|
||||
(dynamic-func "fnmatch"
|
||||
(dynamic-link))
|
||||
(list '* '* int)))
|
||||
(let* ((flags (if case-fold
|
||||
FNM_CASEFOLD
|
||||
0))
|
||||
(result (%c-fnmatch (string->pointer pattern)
|
||||
(string->pointer string)
|
||||
flags)))
|
||||
(cond
|
||||
((= result 0)
|
||||
#t)
|
||||
((or (= result FNM_NOMATCH)
|
||||
(eq? #f allow-error))
|
||||
#f)
|
||||
(else
|
||||
(error "fnmatch errno " result)))))
|
|
@ -0,0 +1,56 @@
|
|||
;; Test case for fnmatch module
|
||||
;;
|
||||
;; Copyright (C) 2014 Mike Gerwitz
|
||||
;;
|
||||
;; This file is part of guile-mime.
|
||||
;;
|
||||
;; guile-mime is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
;;
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
;;
|
||||
;; TODO: We should provide stronger assurances, as this does not
|
||||
;; prevent a bogus implementation.
|
||||
|
||||
|
||||
|
||||
(define-module (test mime fnmatch)
|
||||
#:use-module (srfi srfi-64)
|
||||
#:use-module (mime fnmatch))
|
||||
|
||||
|
||||
|
||||
(test-group
|
||||
"(mime fnmatch)"
|
||||
|
||||
(test-group
|
||||
"fnmatch procedure"
|
||||
|
||||
(test-eq "returns #t when input matches pattern"
|
||||
#t
|
||||
(fnmatch "foo*" "foobar"))
|
||||
|
||||
(test-eq "returns #f when input does not match pattern"
|
||||
#f
|
||||
(fnmatch "foo*" "frobnoz"))
|
||||
|
||||
;; note that we do not test for errors, because POSIX does not
|
||||
;; define any such conditions, and glibc will never return an error
|
||||
|
||||
(test-group
|
||||
"pattern case"
|
||||
|
||||
(test-eq "is not folded by default"
|
||||
#f
|
||||
(fnmatch "foo" "Foo"))
|
||||
(test-eq "is folded with #:case-fold"
|
||||
#t
|
||||
(fnmatch "foo" "Foo" #:case-fold #t)))))
|
Loading…
Reference in New Issue