Change 30161 by [EMAIL PROTECTED] on 2007/02/07 17:31:52
Integrate:
[ 26869]
more case tolerance for vms/ext/filespec.t
[ 27114]
Subject: [EMAIL PROTECTED] Allow fatal exceptions to bring up VMS
debugger
From: "John E. Malmberg" <[EMAIL PROTECTED]>
Date: Sat, 04 Feb 2006 16:04:32 -0500
Message-id: <[EMAIL PROTECTED]>
[ 27115]
Subject: Re: Configure.com issue, more quoting needed.
From: Peter Prymmer <[EMAIL PROTECTED]>
Date: Mon, 06 Feb 2006 13:27:14 -0500
Message-id: <[EMAIL PROTECTED]>
Affected files ...
... //depot/maint-5.8/perl/configure.com#48 integrate
... //depot/maint-5.8/perl/vms/ext/filespec.t#4 integrate
... //depot/maint-5.8/perl/vms/perlvms.pod#9 integrate
... //depot/maint-5.8/perl/vms/vms.c#24 integrate
Differences ...
==== //depot/maint-5.8/perl/configure.com#48 (text) ====
Index: perl/configure.com
--- perl/configure.com#47~30033~ 2007-01-27 08:40:35.000000000 -0800
+++ perl/configure.com 2007-02-07 09:31:52.000000000 -0800
@@ -6966,7 +6966,7 @@
$ WRITE CONFIG "$ libnetcfg == """ + perl_setup_perl + "
''vms_prefix':[utils]libnetcfg.com"""
$ WRITE CONFIG "$ perlbug == """ + perl_setup_perl + "
''vms_prefix':[lib]perlbug.com"""
$ WRITE CONFIG "$!perlcc == """ + perl_setup_perl + "
''vms_prefix':[utils]perlcc.com"""
-$ WRITE CONFIG "$ perldoc == """ + perl_setup_perl + "
''vms_prefix':[lib.pods]perldoc.com -t"""
+$ WRITE CONFIG "$ perldoc == """ + perl_setup_perl + "
''vms_prefix':[lib.pods]perldoc.com """"-t"""""""
$ WRITE CONFIG "$ perlivp == """ + perl_setup_perl + "
''vms_prefix':[utils]perlivp.com"""
$ WRITE CONFIG "$ piconv == """ + perl_setup_perl + "
''vms_prefix':[utils]piconv.com"""
$ WRITE CONFIG "$ pl2pm == """ + perl_setup_perl + "
''vms_prefix':[utils]pl2pm.com"""
==== //depot/maint-5.8/perl/vms/ext/filespec.t#4 (text) ====
Index: perl/vms/ext/filespec.t
--- perl/vms/ext/filespec.t#3~23398~ 2004-10-21 03:54:14.000000000 -0700
+++ perl/vms/ext/filespec.t 2007-02-07 09:31:52.000000000 -0800
@@ -21,7 +21,7 @@
$expect = undef if $expect eq 'undef';
$rslt = eval "$func('$arg')";
is($@, '', "eval ${func}('$arg')");
- is($rslt, $expect, "${func}('$arg'): '$rslt'");
+ is(lc($rslt), lc($expect), "${func}('$arg'): '$rslt'");
}
$defwarn = <<'EOW';
@@ -32,10 +32,10 @@
EOW
is(uc(rmsexpand('[]')), "\U$ENV{DEFAULT}", 'rmsexpand()') || print $defwarn;
-is(rmsexpand('from.here'),"\L$ENV{DEFAULT}from.here") || print $defwarn;
-is(rmsexpand('from'), "\L$ENV{DEFAULT}from") || print $defwarn;
+is(lc(rmsexpand('from.here')),"\L$ENV{DEFAULT}from.here") || print $defwarn;
+is(lc(rmsexpand('from')), "\L$ENV{DEFAULT}from") || print $defwarn;
-is(rmsexpand('from.here','cant:[get.there];2'),
+is(lc(rmsexpand('from.here','cant:[get.there];2')),
'cant:[get.there]from.here;2') || print $defwarn;
==== //depot/maint-5.8/perl/vms/perlvms.pod#9 (text) ====
Index: perl/vms/perlvms.pod
--- perl/vms/perlvms.pod#8~28112~ 2006-05-05 13:21:42.000000000 -0700
+++ perl/vms/perlvms.pod 2007-02-07 09:31:52.000000000 -0800
@@ -367,6 +367,30 @@
except that the element separator is '|' instead of ':'. The
directory specifications may use either VMS or Unix syntax.
+=head1 PERL_VMS_EXCEPTION_DEBUG
+
+The PERL_VMS_EXCEPTION_DEBUG being defined as "ENABLE" will cause the VMS
+debugger to be invoked if a fatal exception that is not otherwise
+handled is raised. The purpose of this is to allow debugging of
+internal Perl problems that would cause such a condition.
+
+This allows the programmer to look at the execution stack and variables to
+find out the cause of the exception. As the debugger is being invoked as
+the Perl interpreter is about to do a fatal exit, continuing the execution
+in debug mode is usally not practical.
+
+Starting Perl in the VMS debugger may change the program execution
+profile in a way that such problems are not reproduced.
+
+The C<kill> function can be used to test this functionality from within
+a program.
+
+In typical VMS style, only the first letter of the value of this logical
+name is actually checked in a case insensitive mode, and it is considered
+enabled if it is the value "T","1" or "E".
+
+This logical name must be defined before Perl is started.
+
=head1 Command line
=head2 I/O redirection and backgrounding
==== //depot/maint-5.8/perl/vms/vms.c#24 (text) ====
Index: perl/vms/vms.c
--- perl/vms/vms.c#23~30160~ 2007-02-07 09:08:56.000000000 -0800
+++ perl/vms/vms.c 2007-02-07 09:31:52.000000000 -0800
@@ -226,6 +226,8 @@
int decc_readdir_dropdotnotype = 0;
static int vms_process_case_tolerant = 1;
+static int vms_debug_on_exception = 0;
+
/* Is this a UNIX file specification?
* No longer a simple check with EFS file specs
* For now, not a full check, but need to
@@ -1452,8 +1454,8 @@
#define _MY_SIG_MAX 17
-unsigned int
-Perl_sig_to_vmscondition(int sig)
+static unsigned int
+Perl_sig_to_vmscondition_int(int sig)
{
static unsigned int sig_code[_MY_SIG_MAX+1] =
{
@@ -1495,6 +1497,17 @@
return sig_code[sig];
}
+unsigned int
+Perl_sig_to_vmscondition(int sig)
+{
+#ifdef SS$_DEBUG
+ if (vms_debug_on_exception != 0)
+ lib$signal(SS$_DEBUG);
+#endif
+ return Perl_sig_to_vmscondition_int(sig);
+}
+
+
int
Perl_my_kill(int pid, int sig)
{
@@ -1530,7 +1543,7 @@
return -1;
}
- code = Perl_sig_to_vmscondition(sig);
+ code = Perl_sig_to_vmscondition_int(sig);
if (!code) {
SETERRNO(EINVAL, SS$_BADPARAM);
@@ -8756,6 +8769,17 @@
unsigned long case_perm;
unsigned long case_image;
+ /* Allow an exception to bring Perl into the VMS debugger */
+ vms_debug_on_exception = 0;
+ status = sys_trnlnm("PERL_VMS_EXCEPTION_DEBUG", val_str, sizeof(val_str));
+ if ($VMS_STATUS_SUCCESS(status)) {
+ if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
+ vms_debug_on_exception = 1;
+ else
+ vms_debug_on_exception = 0;
+ }
+
+
#if __CRTL_VER >= 70300000 && !defined(__VAX)
s = decc$feature_get_index("DECC$DISABLE_TO_VMS_LOGNAME_TRANSLATION");
if (s >= 0) {
End of Patch.
