Change 30320 by [EMAIL PROTECTED] on 2007/02/15 16:30:05
Integrate:
[ 26845]
Friday the 13th, Part II. Don't call SYS$GETJPI with fancy case
lookup stuff on older systems that don't know what it means (broken
in #25306).
[ 27474]
Subject: [PATCH] [EMAIL PROTECTED] fix File::Path::mkpath so that perl
installs on VMS
From: Peter Prymmer <[EMAIL PROTECTED]>
Date: Fri, 10 Mar 2006 15:24:23 -0500
Message-id: <[EMAIL PROTECTED]>
[ 30177]
Switch from Carp to plain old warn in vms/ext/XSSymSet.pm
because Carp now in some cases depends on things that may not
be available from miniperl or before extensions are built.
[ 30216]
In vms/vms.c's declaration of the LIB$INITIALIZE psect, try to get
all of the attributes we need without any of the ones we don't, and
try to be friendly to older compilers without too much damage to
readability. Thanks to Saku Setala for the problem report.
Affected files ...
... //depot/maint-5.8/perl/lib/File/Path.pm#8 integrate
... //depot/maint-5.8/perl/vms/ext/XSSymSet.pm#2 integrate
... //depot/maint-5.8/perl/vms/vms.c#27 integrate
Differences ...
==== //depot/maint-5.8/perl/lib/File/Path.pm#8 (text) ====
Index: perl/lib/File/Path.pm
--- perl/lib/File/Path.pm#7~26590~ 2006-01-02 15:17:17.000000000 -0800
+++ perl/lib/File/Path.pm 2007-02-15 08:30:05.000000000 -0800
@@ -152,9 +152,6 @@
if ($Is_VMS) {
next if $path eq '/';
$path = VMS::Filespec::unixify($path);
- if ($path =~ m:^(/[^/]+)/?\z:) {
- $path = $1.'/000000';
- }
}
next if -d $path;
my $parent = File::Basename::dirname($path);
==== //depot/maint-5.8/perl/vms/ext/XSSymSet.pm#2 (text) ====
Index: perl/vms/ext/XSSymSet.pm
--- perl/vms/ext/XSSymSet.pm#1~17645~ 2002-07-19 12:29:57.000000000 -0700
+++ perl/vms/ext/XSSymSet.pm 2007-02-15 08:30:05.000000000 -0800
@@ -1,6 +1,5 @@
package ExtUtils::XSSymSet;
-use Carp qw( &carp );
use strict;
use vars qw( $VERSION );
$VERSION = '1.0';
@@ -69,7 +68,7 @@
}
}
}
- carp "Warning: long symbol $name\n\ttrimmed to $trimmed\n\t" unless $silent;
+ warn "Warning: long symbol $name\n\ttrimmed to $trimmed\n\t" unless $silent;
return $trimmed;
}
@@ -87,12 +86,12 @@
my($i) = "00";
$trimmed = $self->trimsym($sym,$maxlen-3,$silent);
while (exists $self->{"${trimmed}_$i"}) { $i++; }
- carp "Warning: duplicate symbol $trimmed\n\tchanged to
${trimmed}_$i\n\t(original was $sym)\n\t"
+ warn "Warning: duplicate symbol $trimmed\n\tchanged to
${trimmed}_$i\n\t(original was $sym)\n\t"
unless $silent;
$trimmed .= "_$i";
}
elsif (not $silent and $trimmed ne $sym) {
- carp "Warning: long symbol $sym\n\ttrimmed to $trimmed\n\t";
+ warn "Warning: long symbol $sym\n\ttrimmed to $trimmed\n\t";
}
$self->{$trimmed} = $sym;
$self->{'__N+Map'}->{$sym} = $trimmed;
==== //depot/maint-5.8/perl/vms/vms.c#27 (text) ====
Index: perl/vms/vms.c
--- perl/vms/vms.c#26~30164~ 2007-02-07 13:38:12.000000000 -0800
+++ perl/vms/vms.c 2007-02-15 08:30:05.000000000 -0800
@@ -9099,10 +9099,12 @@
int dflt;
char* str;
char val_str[10];
+#if defined(JPI$_CASE_LOOKUP_PERM) && !defined(__VAX)
const unsigned long int jpicode1 = JPI$_CASE_LOOKUP_PERM;
const unsigned long int jpicode2 = JPI$_CASE_LOOKUP_IMAGE;
unsigned long case_perm;
unsigned long case_image;
+#endif
/* Allow an exception to bring Perl into the VMS debugger */
vms_debug_on_exception = 0;
@@ -9253,7 +9255,7 @@
}
#endif
-#ifndef __VAX
+#if defined(JPI$_CASE_LOOKUP_PERM) && !defined(__VAX)
/* Report true case tolerance */
/*----------------------------*/
@@ -9277,25 +9279,19 @@
}
#ifdef __DECC
-/* DECC dependent attributes */
-#if __DECC_VER < 60560002
-#define relative
-#define not_executable
-#else
-#define relative ,rel
-#define not_executable ,noexe
-#endif
#pragma nostandard
#pragma extern_model save
#pragma extern_model strict_refdef "LIB$INITIALIZ" nowrt
-#endif
const __align (LONGWORD) int spare[8] = {0};
-/* .psect LIB$INITIALIZE, NOPIC, USR, CON, REL, GBL, NOSHR, NOEXE, RD, */
-/* NOWRT, LONG */
-#ifdef __DECC
-#pragma extern_model strict_refdef "LIB$INITIALIZE" con, gbl,noshr, \
- nowrt,noshr relative not_executable
+
+/* .psect LIB$INITIALIZE, NOPIC, USR, CON, REL, GBL, NOSHR, NOEXE, RD, NOWRT,
LONG */
+#if __DECC_VER >= 60560002
+#pragma extern_model strict_refdef "LIB$INITIALIZE" nopic, con, rel, gbl,
noshr, noexe, nowrt, long
+#else
+#pragma extern_model strict_refdef "LIB$INITIALIZE" nopic, con, gbl, noshr,
nowrt, long
#endif
+#endif /* __DECC */
+
const long vms_cc_features = (const long)set_features;
/*
End of Patch.
