File::Glob stuff for Mac OS

Message-Id: <p05010400b6eaab36051c@[10.0.1.177]>

p4raw-id: //depot/perl@9479

6 files changed, 132 insertions, 37 deletions

diff --git a/ext/File/Glob/Glob.pm b/ext/File/Glob/Glob.pm
index 76adbe7b3d..561f33154d 100644
--- a/ext/File/Glob/Glob.pm
+++ b/ext/File/Glob/Glob.pm
@@ -376,14 +376,32 @@ Win32 users should use the real slash.  If you really want to use
 backslashes, consider using Sarathy's File::DosGlob, which comes with
 the standard Perl distribution.
 
+=item *
+
+Mac OS (Classic) users should note a few differences. Since
+Mac OS is not Unix, when the glob code encounters a tilde glob (e.g.
+~user/foo) and the C<GLOB_TILDE> flag is used, it simply returns that
+pattern without doing any expansion.
+
+Glob on Mac OS is case-insensitive by default (if you don't use any
+flags). If you specify any flags at all and still want glob
+to be case-insensitive, you must include C<GLOB_NOCASE> in the flags.
+
+The path separator is ':' (aka colon), not '/' (aka slash). Mac OS users
+should be careful about specifying relative pathnames. While a full path
+always begins with a volume name, a relative pathname should always
+begin with a ':'.  If specifying a volume name only, a trailing ':' is
+required.
+
 =back
 
 =head1 AUTHOR
 
 The Perl interface was written by Nathan Torkington E<lt>gnat@frii.comE<gt>,
 and is released under the artistic license.  Further modifications were
-made by Greg Bacon E<lt>gbacon@cs.uah.eduE<gt> and Gurusamy Sarathy
-E<lt>gsar@activestate.comE<gt>.  The C glob code has the
+made by Greg Bacon E<lt>gbacon@cs.uah.eduE<gt>, Gurusamy Sarathy
+E<lt>gsar@activestate.comE<gt>, and Thomas Wegner
+E<lt>wegner_thomas@yahoo.comE<gt>.  The C glob code has the
 following copyright:
 
     Copyright (c) 1989, 1993 The Regents of the University of California.
diff --git a/ext/File/Glob/bsd_glob.c b/ext/File/Glob/bsd_glob.c
index a0becd1e14..6e2c9f1e85 100644
--- a/ext/File/Glob/bsd_glob.c
+++ b/ext/File/Glob/bsd_glob.c
@@ -79,8 +79,11 @@ static char sccsid[] = "@(#)glob.c	8.3 (Berkeley) 10/13/93";
 #ifndef MAXPATHLEN
 #  ifdef PATH_MAX
 #    define	MAXPATHLEN	PATH_MAX
-#  else
-#    define	MAXPATHLEN	1024
+#    ifdef MACOS_TRADITIONAL
+#      define	MAXPATHLEN	255
+#    else
+#      define	MAXPATHLEN	1024
+#    endif
 #  endif
 #endif
 
@@ -93,7 +96,11 @@ static char sccsid[] = "@(#)glob.c	8.3 (Berkeley) 10/13/93";
 #define	BG_QUOTE	'\\'
 #define	BG_RANGE	'-'
 #define	BG_RBRACKET	']'
-#define	BG_SEP		'/'
+#ifdef MACOS_TRADITIONAL
+#  define	BG_SEP	':'
+#else
+#  define	BG_SEP	'/'
+#endif
 #ifdef DOSISH
 #define BG_SEP2		'\\'
 #endif
@@ -451,6 +458,12 @@ glob0(const Char *pattern, glob_t *pglob)
 	int c, err, oldflags, oldpathc;
 	Char *bufnext, patbuf[MAXPATHLEN+1];
 
+#ifdef MACOS_TRADITIONAL
+	if ( (*pattern == BG_TILDE) && (pglob->gl_flags & GLOB_TILDE) ) {
+		return(globextend(pattern, pglob));
+	}
+#endif
+
 	qpat = globtilde(pattern, patbuf, pglob);
 	qpatnext = qpat;
 	oldflags = pglob->gl_flags;
@@ -861,10 +874,15 @@ g_opendir(register Char *str, glob_t *pglob)
 {
 	char buf[MAXPATHLEN];
 
-	if (!*str)
+	if (!*str) {
+#ifdef MACOS_TRADITIONAL
+		strcpy(buf, ":");
+#else
 		strcpy(buf, ".");
-	else
+#endif
+	} else {
 		g_Ctoc(str, buf);
+	}
 
 	if (pglob->gl_flags & GLOB_ALTDIRFUNC)
 		return((*pglob->gl_opendir)(buf));
diff --git a/t/lib/glob-basic.t b/t/lib/glob-basic.t
index ec2f53985f..170237fc8a 100755
--- a/t/lib/glob-basic.t
+++ b/t/lib/glob-basic.t
@@ -2,7 +2,12 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    if ($^O eq 'MacOS') { 
+	@INC = qw(: ::lib ::macos:lib); 
+    } else { 
+	@INC = '.'; 
+	push @INC, '../lib'; 
+    }
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
         print "1..0\n";
@@ -26,7 +31,7 @@ sub array {
 $ENV{PATH} = "/bin";
 delete @ENV{BASH_ENV, CDPATH, ENV, IFS};
 @correct = ();
-if (opendir(D, ".")) {
+if (opendir(D, $^O eq "MacOS" ? ":" : ".")) {
    @correct = grep { !/^\./ } sort readdir(D);
    closedir D;
 }
@@ -120,7 +125,7 @@ print "ok 8\n";
 # "~" should expand to $ENV{HOME}
 $ENV{HOME} = "sweet home";
 @a = bsd_glob('~', GLOB_TILDE | GLOB_NOMAGIC);
-unless (@a == 1 and $a[0] eq $ENV{HOME}) {
+unless ($^O eq "MacOS" || (@a == 1 and $a[0] eq $ENV{HOME})) {
     print "not ";
 }
 print "ok 9\n";
diff --git a/t/lib/glob-case.t b/t/lib/glob-case.t
index 56d35f3d03..881470cf84 100755
--- a/t/lib/glob-case.t
+++ b/t/lib/glob-case.t
@@ -2,7 +2,12 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    if ($^O eq 'MacOS') { 
+	@INC = qw(: ::lib ::macos:lib); 
+    } else { 
+	@INC = '.'; 
+	push @INC, '../lib'; 
+    }
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
         print "1..0\n";
@@ -17,20 +22,22 @@ use File::Glob qw(:glob csh_glob);
 $loaded = 1;
 print "ok 1\n";
 
+my $pat = $^O eq "MacOS" ? ":lib:G*.t" : "lib/G*.t";
+
 # Test the actual use of the case sensitivity tags, via csh_glob()
 import File::Glob ':nocase';
-@a = csh_glob("lib/G*.t"); # At least glob-basic.t glob-case.t glob-global.t
+@a = csh_glob($pat); # At least glob-basic.t glob-case.t glob-global.t
 print "not " unless @a >= 3;
 print "ok 2\n";
 
 # This may fail on systems which are not case-PRESERVING
 import File::Glob ':case';
-@a = csh_glob("lib/G*.t"); # None should be uppercase
+@a = csh_glob($pat); # None should be uppercase
 print "not " unless @a == 0;
 print "ok 3\n";
 
 # Test the explicit use of the GLOB_NOCASE flag
-@a = bsd_glob("lib/G*.t", GLOB_NOCASE);
+@a = bsd_glob($pat, GLOB_NOCASE);
 print "not " unless @a >= 3;
 print "ok 4\n";
 
diff --git a/t/lib/glob-global.t b/t/lib/glob-global.t
index a82408c93e..1d7903275b 100755
--- a/t/lib/glob-global.t
+++ b/t/lib/glob-global.t
@@ -2,7 +2,12 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    if ($^O eq 'MacOS') { 
+	@INC = qw(: ::lib ::macos:lib); 
+    } else { 
+	@INC = '.'; 
+	push @INC, '../lib'; 
+    }
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
         print "1..0\n";
@@ -31,9 +36,9 @@ use File::Glob ':globally';
 $loaded = 1;
 print "ok 1\n";
 
-$_ = "lib/*.t";
+$_ = $^O eq "MacOS" ? ":lib:*.t" : "lib/*.t";
 my @r = glob;
-print "not " if $_ ne 'lib/*.t';
+print "not " if $_ ne ($^O eq "MacOS" ? ":lib:*.t" : "lib/*.t");
 print "ok 2\n";
 
 # we should have at least basic.t, global.t, taint.t
@@ -41,7 +46,11 @@ print "# |@r|\nnot " if @r < 3;
 print "ok 3\n";
 
 # check if <*/*> works
-@r = <*/*.t>;
+if ($^O eq "MacOS") {
+    @r = <:*:*.t>;
+} else {
+    @r = <*/*.t>;
+}
 # at least t/global.t t/basic.t, t/taint.t
 print "not " if @r < 3;
 print "ok 4\n";
@@ -49,34 +58,55 @@ my $r = scalar @r;
 
 # check if scalar context works
 @r = ();
-while (defined($_ = <*/*.t>)) {
-    #print "# $_\n";
-    push @r, $_;
+if ($^O eq "MacOS") {
+    while (defined($_ = <:*:*.t>)) {
+	#print "# $_\n";
+	push @r, $_;
+    }
+} else {
+    while (defined($_ = <*/*.t>)) {
+	#print "# $_\n";
+	push @r, $_;
+    }
 }
 print "not " if @r != $r;
 print "ok 5\n";
 
 # check if list context works
 @r = ();
-for (<*/*.t>) {
-    #print "# $_\n";
-    push @r, $_;
+if ($^O eq "MacOS") {
+    for (<:*:*.t>) {
+	#print "# $_\n";
+	push @r, $_;
+    }
+} else {
+    for (<*/*.t>) {
+	#print "# $_\n";
+	push @r, $_;
+    }
 }
 print "not " if @r != $r;
 print "ok 6\n";
 
 # test if implicit assign to $_ in while() works
 @r = ();
-while (<*/*.t>) {
-    #print "# $_\n";
-    push @r, $_;
+if ($^O eq "MacOS") {
+    while (<:*:*.t>) {
+	#print "# $_\n";
+	push @r, $_;
+    }
+} else {
+    while (<*/*.t>) {
+	#print "# $_\n";
+	push @r, $_;
+    }
 }
 print "not " if @r != $r;
 print "ok 7\n";
 
 # test if explicit glob() gets assign magic too
 my @s = ();
-while (glob '*/*.t') {
+while (glob($^O eq 'MacOS' ? ':*:*.t' : '*/*.t')) {
     #print "# $_\n";
     push @s, $_;
 }
@@ -87,7 +117,7 @@ print "ok 8\n";
 package Foo;
 use File::Glob ':globally';
 @s = ();
-while (glob '*/*.t') {
+while (glob($^O eq 'MacOS' ? ':*:*.t' : '*/*.t')) {
     #print "# $_\n";
     push @s, $_;
 }
@@ -97,14 +127,26 @@ print "ok 9\n";
 # test if different glob ops maintain independent contexts
 @s = ();
 my $i = 0;
-while (<*/*.t>) {
-    #print "# $_ <";
-    push @s, $_;
-    while (<bas*/*.t>) {
-        #print " $_";
-        $i++;
+if ($^O eq "MacOS") {
+    while (<:*:*.t>) {
+	#print "# $_ <";
+	push @s, $_;
+	while (<:bas*:*.t>) {
+	    #print " $_";
+	    $i++;
+	}
+	#print " >\n";
+    }
+} else {
+    while (<*/*.t>) {
+	#print "# $_ <";
+	push @s, $_;
+	while (<bas*/*.t>) {
+	    #print " $_";
+	    $i++;
+	}
+	#print " >\n";
     }
-    #print " >\n";
 }
 print "not " if "@r" ne "@s" or not $i;
 print "ok 10\n";
diff --git a/t/lib/glob-taint.t b/t/lib/glob-taint.t
index fe2fa23106..4c0990358d 100755
--- a/t/lib/glob-taint.t
+++ b/t/lib/glob-taint.t
@@ -2,7 +2,12 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    if ($^O eq 'MacOS') { 
+	@INC = qw(: ::lib ::macos:lib); 
+    } else { 
+	@INC = '.'; 
+	push @INC, '../lib'; 
+    }
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
         print "1..0\n";