globs: add "glob-parent-directory" word that returns the deepest level of a path...

diff --git a/basis/globs/globs-tests.factor b/basis/globs/globs-tests.factor
index eceb6bab7b6e671ccd5e1f13eecc7777b36ec19e..c9903b163348454ca4df67479871ca82ea6df044 100644 (file)
--- a/basis/globs/globs-tests.factor
+++ b/basis/globs/globs-tests.factor
@@ -1,4 +1,4 @@
-USING: tools.test globs io.pathnames ;
+USING: arrays tools.test globs io.pathnames sequences ;
 IN: globs.tests
 
 [ f ] [ "abd" "fdf" glob-matches? ] unit-test
@@ -22,3 +22,19 @@ IN: globs.tests
 [ t ] [ "foo" "bar" append-path "*" "*" append-path glob-matches? ] unit-test
 [ f ] [ "foo" "bar" append-path "foo?bar" glob-matches? ] unit-test
 [ t ] [ "foo" "bar" append-path "fo?" "bar" append-path glob-matches? ] unit-test
+
+[ f ] [ "foo" glob-pattern? ] unit-test
+[ t ] [ "fo?" glob-pattern? ] unit-test
+[ t ] [ "fo*" glob-pattern? ] unit-test
+[ t ] [ "fo[mno]" glob-pattern? ] unit-test
+[ t ] [ "fo\\*" glob-pattern? ] unit-test
+[ t ] [ "fo{o,bro}" glob-pattern? ] unit-test
+
+"foo" "bar" append-path 1array
+[ { "foo" "bar" "ba?" } path-separator join glob-parent-directory ] unit-test
+
+[ "foo" ] 
+[ { "foo" "b?r" "bas" } path-separator join glob-parent-directory ] unit-test
+
+[ "" ] 
+[ { "f*" "bar" "bas" } path-separator join glob-parent-directory ] unit-test

diff --git a/basis/globs/globs.factor b/basis/globs/globs.factor
index 47c8fca5284bada119806fff7e401ee258ee6f09..72b686c3b1db7cc603037b055d9b7ab02b2dd4d1 100644 (file)
--- a/basis/globs/globs.factor
+++ b/basis/globs/globs.factor
@@ -43,3 +43,10 @@ Main = Concatenation End
 
 : glob-matches? ( input glob -- ? )
     [ >case-fold ] bi@ <glob> matches? ;
+
+: glob-pattern? ( string -- ? )
+    [ "\\*?[{" member? ] any? ;
+
+: glob-parent-directory ( glob -- parent-directory )
+    path-components dup [ glob-pattern? ] find drop head
+    path-separator join ;