Change 16473: Various syncs from macperl/ -> maint-5.6/macperl/
[email protected] (Chris Nandor) Wed, 8 May 2002 01:04:21 -0400
| Newsgroups | perl.perl5.changes.mac |
|---|---|
| Message-ID | <p05100306b8fe6243bd8e@[10.0.1.177]> |
Change 16473 by pudge@pudge-mobile on 2002/05/08 03:52:28
Various syncs from macperl/ -> maint-5.6/macperl/
File::Copy, File::Spec updates
Test script modifications
pp_require path bugfixes
Affected files ...
.... //depot/maint-5.6/macperl/lib/File/Copy.pm#3 edit
.... //depot/maint-5.6/macperl/lib/File/Spec/Mac.pm#5 edit
.... //depot/maint-5.6/macperl/macos/MacPerlTests.plx#3 edit
.... //depot/maint-5.6/macperl/macos/configpm#4 edit
.... //depot/maint-5.6/macperl/macos/macish.c#11 edit
.... //depot/maint-5.6/macperl/macos/macish.h#10 edit
.... //depot/maint-5.6/macperl/pp_ctl.c#7 edit
Differences ...
==== //depot/maint-5.6/macperl/lib/File/Copy.pm#3 (text) ====
Index: macperl/lib/File/Copy.pm
--- macperl/lib/File/Copy.pm#2~11185~ Fri Jul 6 16:46:57 2001
+++ macperl/lib/File/Copy.pm Tue May 7 20:52:28 2002
@@ -31,6 +31,13 @@
$Too_Big = 1024 * 1024 * 2;
+my $macfiles;
+if ($^O eq 'MacOS') {
+ $macfiles = eval { require Mac::MoreFiles };
+ warn 'Mac::MoreFiles could not be loaded; using non-native syscopy'
+ if $^W;
+}
+
sub _catname {
my($from, $to) = @_;
if (not defined &basename) {
@@ -40,7 +47,7 @@
if ($^O eq 'MacOS') {
# a partial dir name that's valid only in the cwd (e.g. 'tmp')
- $to = ':' . $to if $to =~ /^[^:]+$/;
+ $to = ':' . $to if $to !~ /:/;
}
return File::Spec->catfile($to, basename($from));
@@ -208,8 +215,7 @@
return 0 unless @_ == 2;
return Win32::CopyFile(@_, 1);
};
- } elsif ($^O eq 'MacOS') {
- require Mac::MoreFiles;
+ } elsif ($macfiles) {
*syscopy = sub {
my($from, $to) = @_;
my($dir, $toname);
@@ -313,6 +319,9 @@
C<copy> routine. For VMS systems, this calls the C<rmscopy>
routine (see below). For OS/2 systems, this calls the C<syscopy>
XSUB directly. For Win32 systems, this calls C<Win32::CopyFile>.
+
+On Mac OS (Classic), C<syscopy> calls C<Mac::MoreFiles::FSpFileCopy>,
+if available.
=head2 Special behaviour if C<syscopy> is defined (OS/2, VMS and Win32)
==== //depot/maint-5.6/macperl/lib/File/Spec/Mac.pm#5 (text) ====
Index: macperl/lib/File/Spec/Mac.pm
--- macperl/lib/File/Spec/Mac.pm#4~13154~ Tue Nov 20 19:16:55 2001
+++ macperl/lib/File/Spec/Mac.pm Tue May 7 20:52:28 2002
@@ -9,6 +9,10 @@
@ISA = qw(File::Spec::Unix);
use Cwd;
+my $macfiles;
+if ($^O eq 'MacOS') {
+ $macfiles = eval { require Mac::Files };
+}
=head1 NAME
@@ -339,6 +343,8 @@
trailing ":", because that's the correct specification for a volume
name on Mac OS.
+If Mac::Files could not be loaded, the empty string is returned.
+
=cut
sub rootdir {
@@ -346,9 +352,9 @@
# There's no real root directory on Mac OS. The name of the startup
# volume is returned, since that's the closest in concept.
#
- require Mac::Files;
- my $system = Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk,
- &Mac::Files::kSystemFolderType);
+ return '' unless $macfiles;
+ my $system = Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk,
+ &Mac::Files::kSystemFolderType);
$system =~ s/:.*\Z(?!\n)/:/s;
return $system;
}
==== //depot/maint-5.6/macperl/macos/MacPerlTests.plx#3 (text) ====
Index: macperl/macos/MacPerlTests.plx
--- macperl/macos/MacPerlTests.plx#2~12188~ Mon Sep 24 19:36:19 2001
+++ macperl/macos/MacPerlTests.plx Tue May 7 20:52:28 2002
@@ -22,6 +22,10 @@
}
}
}
+if ($script) {
+ $tests{$script}{num} = $num;
+ $tests{$script}{tests} = [@tests];
+}
for my $script (sort keys %tests) {
my @not = grep {
==== //depot/maint-5.6/macperl/macos/configpm#4 (text) ====
Index: macperl/macos/configpm
--- macperl/macos/configpm#3~13126~ Mon Nov 19 19:28:51 2001
+++ macperl/macos/configpm Tue May 7 20:52:28 2002
@@ -293,6 +293,11 @@
myarchname => $arch,
cc => $cc,
);
+
+# if (eval { require Mac::Gestalt }) {
+# $preconfig{osvers} = join '.', split //, sprintf "%x",
+# $Mac::Gestalt::Gestalt{Mac::Gestalt::gestaltSystemVersion()};
+# }
}
sub TIEHASH { bless { %preconfig } }
==== //depot/maint-5.6/macperl/macos/macish.c#11 (text) ====
Index: macperl/macos/macish.c
--- macperl/macos/macish.c#10~14069~ Fri Jan 4 12:28:20 2002
+++ macperl/macos/macish.c Tue May 7 20:52:28 2002
@@ -683,7 +683,7 @@
}
#endif
-const char * MacPerl_CanonDir(const char * dir, char * buf)
+const char * MacPerl_CanonDir(const char * dir, char * buf, Boolean is_file)
{
char * out = buf;
char * slash;
@@ -723,7 +723,7 @@
memcpy(out, dir, slash-dir);
out += slash-dir;
*out++ = ':';
- for (;;) {
+ while (*slash == '/') {
while (*++slash == '/')
;
if (slash[0] == '.') {
@@ -748,7 +748,7 @@
done:
strcpy(out, dir);
out += strlen(out);
- if (out[-1] != ':')
+ if (!is_file && out[-1] != ':')
*out++ = ':';
*out = 0;
@@ -821,6 +821,7 @@
Dequeue(elem, &sMacPerlAsyncQueue);
}
}
+
/*
* Asynchronous tasks come in handy to exit gracefully from the middle of a script
==== //depot/maint-5.6/macperl/macos/macish.h#10 (text) ====
Index: macperl/macos/macish.h
--- macperl/macos/macish.h#9~12822~ Fri Nov 2 13:38:22 2001
+++ macperl/macos/macish.h Tue May 7 20:52:28 2002
@@ -74,7 +74,7 @@
char * MacPerl_MPWFileName(char * file);
char * GetSysErrText(short, char *);
unsigned char * MacPerl_CopyC2P(const char * c, unsigned char * p);
-const char * MacPerl_CanonDir(const char * dir, char * buf);
+const char * MacPerl_CanonDir(const char * dir, char * buf, Boolean is_file);
void MacPerl_WriteMsg(void * io, const char * msg, size_t len);
void MacPerl_Exit(int status);
==== //depot/maint-5.6/macperl/pp_ctl.c#7 (text) ====
Index: macperl/pp_ctl.c
--- macperl/pp_ctl.c#6~14607~ Fri Feb 8 11:21:04 2002
+++ macperl/pp_ctl.c Tue May 7 20:52:28 2002
@@ -3032,6 +3032,17 @@
tryname = name;
tryrsfp = doopen_pmc(name,PERL_SCRIPT_MODE);
}
+#ifdef MACOS_TRADITIONAL
+ if (!tryrsfp) {
+ char newname[256];
+
+ MacPerl_CanonDir(name, newname, 1);
+ if (path_is_absolute(newname)) {
+ tryname = newname;
+ tryrsfp = doopen_pmc(newname,PERL_SCRIPT_MODE);
+ }
+ }
+#endif
if (!tryrsfp) {
AV *ar = GvAVn(PL_incgv);
I32 i;
@@ -3162,8 +3173,11 @@
) {
char *dir = SvPVx(dirsv, n_a);
#ifdef MACOS_TRADITIONAL
- char buf[256];
- Perl_sv_setpvf(aTHX_ namesv, "%s%s", MacPerl_CanonDir(dir, buf), name+(name[0] == ':'));
+ char buf1[256];
+ char buf2[256];
+
+ MacPerl_CanonDir(name, buf2, 1);
+ Perl_sv_setpvf(aTHX_ namesv, "%s%s", MacPerl_CanonDir(dir, buf1, 0), buf2+(buf2[0] == ':'));
#else
#ifdef VMS
char *unixdir;
@@ -3177,14 +3191,6 @@
#endif
TAINT_PROPER("require");
tryname = SvPVX(namesv);
-#ifdef MACOS_TRADITIONAL
- {
- /* Convert slashes in the name part, but not the directory part, to colons */
- char * colon;
- for (colon = tryname+strlen(dir); colon = strchr(colon, '/'); )
- *colon++ = ':';
- }
-#endif
tryrsfp = doopen_pmc(tryname, PERL_SCRIPT_MODE);
if (tryrsfp) {
if (tryname[0] == '.' && tryname[1] == '/')
@@ -4665,7 +4671,7 @@
{
if (PERL_FILE_IS_ABSOLUTE(name)
#ifdef MACOS_TRADITIONAL
- || (*name == ':' && name[1] != ':' && strchr(name+2, ':')))
+ || (*name == ':'))
#else
|| (*name == '.' && (name[1] == '/' ||
(name[1] == '.' && name[2] == '/'))))
@@ -4676,4 +4682,3 @@
else
return FALSE;
}
-
End of Patch.