Change 31746 by [EMAIL PROTECTED] on 2007/08/22 11:08:01
Subject: [EMAIL PROTECTED] Module-load/require fixes for VMS
From: "John E. Malmberg" <[EMAIL PROTECTED]>
Date: Mon, 20 Aug 2007 21:55:07 -0500
Message-id: <[EMAIL PROTECTED]>
Avoid double module loads by populating %INC keys in unix format.
Affected files ...
... //depot/perl/lib/Module/Load/Conditional/t/01_Module_Load_Conditional.t#7
edit
... //depot/perl/lib/Module/Load/t/01_Module-Load.t#2 edit
... //depot/perl/pp_ctl.c#621 edit
Differences ...
==== //depot/perl/lib/Module/Load/Conditional/t/01_Module_Load_Conditional.t#7
(text) ====
Index: perl/lib/Module/Load/Conditional/t/01_Module_Load_Conditional.t
--- perl/lib/Module/Load/Conditional/t/01_Module_Load_Conditional.t#6~31727~
2007-08-17 03:55:22.000000000 -0700
+++ perl/lib/Module/Load/Conditional/t/01_Module_Load_Conditional.t
2007-08-22 04:08:01.000000000 -0700
@@ -54,8 +54,9 @@
@rv_path = File::Spec::Unix->splitpath($rv->{file});
} else {
@rv_path = File::Spec->splitpath($rv->{file});
+ @rv_path = ($rv_path[0],
+ File::Spec->splitdir($rv_path[1]), $rv_path[2]);
}
- @rv_path = ($rv_path[0], File::Spec->splitdir($rv_path[1]), $rv_path[2]);
# First element could be blank for some system types like VMS
shift @rv_path if $rv_path[0] eq '';
@@ -169,7 +170,6 @@
{ package A::B::C::D;
$A::B::C::D::VERSION = $$;
$INC{'A/B/C/D.pm'} = $$.$$;
- $INC{'[.A.B.C]D.pm'} = $$.$$ if $^O eq 'VMS';
}
my $href = check_install( module => 'A::B::C::D', version => 0 );
==== //depot/perl/lib/Module/Load/t/01_Module-Load.t#2 (text) ====
Index: perl/lib/Module/Load/t/01_Module-Load.t
--- perl/lib/Module/Load/t/01_Module-Load.t#1~28695~ 2006-08-11
05:52:51.000000000 -0700
+++ perl/lib/Module/Load/t/01_Module-Load.t 2007-08-22 04:08:01.000000000
-0700
@@ -18,6 +18,9 @@
my $mod = 'Must::Be::Loaded';
my $file = Module::Load::_to_file($mod,1);
+ # %INC on VMS has all keys in UNIX format
+ $file = VMS::Filespec::unixify($file) if $^O eq 'VMS';
+
eval { load $mod };
is( $@, '', qq[Loading module '$mod'] );
==== //depot/perl/pp_ctl.c#621 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#620~31586~ 2007-07-11 02:00:49.000000000 -0700
+++ perl/pp_ctl.c 2007-08-22 04:08:01.000000000 -0700
@@ -3066,6 +3066,9 @@
SV *sv;
const char *name;
STRLEN len;
+ char * unixname;
+ STRLEN unixlen;
+ int vms_unixname = 0;
const char *tryname = NULL;
SV *namesv = NULL;
const I32 gimme = GIMME_V;
@@ -3115,8 +3118,31 @@
if (!(name && len > 0 && *name))
DIE(aTHX_ "Null filename used");
TAINT_PROPER("require");
+
+
+#ifdef VMS
+ /* The key in the %ENV hash is in the syntax of file passed as the argument
+ * usually this is in UNIX format, but sometimes in VMS format, which
+ * can result in a module being pulled in more than once.
+ * To prevent this, the key must be stored in UNIX format if the VMS
+ * name can be translated to UNIX.
+ */
+ if ((unixname = tounixspec(name, NULL)) != NULL) {
+ unixlen = strlen(unixname);
+ vms_unixname = 1;
+ }
+ else
+#endif
+ {
+ /* if not VMS or VMS name can not be translated to UNIX, pass it
+ * through.
+ */
+ unixname = (char *) name;
+ unixlen = len;
+ }
if (PL_op->op_type == OP_REQUIRE) {
- SV * const * const svp = hv_fetch(GvHVn(PL_incgv), name, len, 0);
+ SV * const * const svp = hv_fetch(GvHVn(PL_incgv),
+ unixname, unixlen, 0);
if ( svp ) {
if (*svp != &PL_sv_undef)
RETPUSHYES;
@@ -3146,8 +3172,7 @@
AV * const ar = GvAVn(PL_incgv);
I32 i;
#ifdef VMS
- char *unixname;
- if ((unixname = tounixspec(name, NULL)) != NULL)
+ if (vms_unixname)
#endif
{
namesv = newSV(0);
@@ -3372,11 +3397,13 @@
/* name is never assigned to again, so len is still strlen(name) */
/* Check whether a hook in @INC has already filled %INC */
if (!hook_sv) {
- (void)hv_store(GvHVn(PL_incgv), name, len,
newSVpv(CopFILE(&PL_compiling),0),0);
+ (void)hv_store(GvHVn(PL_incgv),
+ unixname, unixlen, newSVpv(CopFILE(&PL_compiling),0),0);
} else {
- SV** const svp = hv_fetch(GvHVn(PL_incgv), name, len, 0);
+ SV** const svp = hv_fetch(GvHVn(PL_incgv), unixname, unixlen, 0);
if (!svp)
- (void)hv_store(GvHVn(PL_incgv), name, len,
SvREFCNT_inc_simple(hook_sv), 0 );
+ (void)hv_store(GvHVn(PL_incgv),
+ unixname, unixlen, SvREFCNT_inc_simple(hook_sv), 0 );
}
ENTER;
End of Patch.
