develooper Front page | perl.perl5.porters | Postings from June 2003

[PATCH] allow $^D = "flags"

Thread Next
From:
Dave Mitchell
Date:
June 27, 2003 14:25
Subject:
[PATCH] allow $^D = "flags"
Message ID:
20030627212624.GB12887@fdgroup.com
Currently the -D command-line switch allows both numeric and symbolic
values, eg -D10 or -Dst, but the equivalent internal var only allows
numeric values. This patch allows you to also use symbolic values
in assignments, eg

    $^D = "st";

This is epecially useful now that the numeric values have reached
2097152.

It also now reports errors for invalid switches; in the past, -D flag
processing used to stop at the first invalid flag and assume it was
the next option, ie -DstV got interpreted as -Dst -V; now instead
it outputs

    invalid option -DV

Dave.

-- 
Justice is when you get what you deserve.
Law is when you get what you pay for.


# This is a patch for 19853.ORIG to update it to 19853-debug
# 
# To apply this patch:
# STEP 1: Chdir to the source directory.
# STEP 2: Run the 'applypatch' program with this patch file as input.
#
# If you do not have 'applypatch', it is part of the 'makepatch' package
# that you can fetch from the Comprehensive Perl Archive Network:
# http://www.perl.com/CPAN/authors/Johan_Vromans/makepatch-x.y.tar.gz
# In the above URL, 'x' should be 2 or higher.
#
# To apply this patch without the use of 'applypatch':
# STEP 1: Chdir to the source directory.
# STEP 2: Run the 'patch' program with this file as input.
#
#### End of Preamble ####

#### Patch data follows ####
diff -up '19853.ORIG/embed.fnc' '19853-debug/embed.fnc'
Index: ./embed.fnc
--- ./embed.fnc	Wed Jun 25 22:29:09 2003
+++ ./embed.fnc	Fri Jun 27 21:05:36 2003
@@ -1385,6 +1385,9 @@ sd	|void	|cv_dump	|CV *cv|char *title
 #endif
 pd 	|CV*	|find_runcv	|U32 *db_seqp
 p	|void	|free_tied_hv_pool
+#if defined(DEBUGGING)
+p	|int	|get_debug_opts	|char **s
+#endif
 
 
 
diff -up '19853.ORIG/mg.c' '19853-debug/mg.c'
Index: ./mg.c
--- ./mg.c	Wed Jun 25 22:28:53 2003
+++ ./mg.c	Fri Jun 27 21:44:24 2003
@@ -1975,8 +1975,13 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	break;
 
     case '\004':	/* ^D */
-	PL_debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | DEBUG_TOP_FLAG;
+#ifdef DEBUGGING
+	s = SvPV_nolen(sv);
+	PL_debug = get_debug_opts(&s) | DEBUG_TOP_FLAG;
 	DEBUG_x(dump_all());
+#else
+	PL_debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | DEBUG_TOP_FLAG;
+#endif
 	break;
     case '\005':  /* ^E */
 	if (*(mg->mg_ptr+1) == '\0') {
diff -up '19853.ORIG/perl.c' '19853-debug/perl.c'
Index: ./perl.c
--- ./perl.c	Wed Jun 25 22:28:53 2003
+++ ./perl.c	Fri Jun 27 21:35:14 2003
@@ -2164,6 +2164,40 @@ NULL
 	PerlIO_printf(PerlIO_stdout(), "\n  %s", *p++);
 }
 
+/* convert a string of -D options (or digits) into an int.
+ * sets *s to point to the char after the options */
+
+#ifdef DEBUGGING
+int
+Perl_get_debug_opts(pTHX_ char **s)
+{
+    int i = 0;
+    if (isALPHA(**s)) {
+	/* if adding extra options, remember to update DEBUG_MASK */
+	static char debopts[] = "psltocPmfrxu HXDSTRJvC";
+
+	for (; isALNUM(**s); (*s)++) {
+	    char *d = strchr(debopts,**s);
+	    if (d)
+		i |= 1 << (d - debopts);
+	    else if (ckWARN_d(WARN_DEBUGGING))
+		Perl_warner(aTHX_ packWARN(WARN_DEBUGGING),
+		    "invalid option -D%c\n", **s);
+	}
+    }
+    else {
+	i = atoi(*s);
+	for (; isALNUM(**s); (*s)++) ;
+    }
+#  ifdef EBCDIC
+    if ((i & DEBUG_p_FLAG) && ckWARN_d(WARN_DEBUGGING))
+	Perl_warner(aTHX_ packWARN(WARN_DEBUGGING),
+		"-Dp not implemented on this platform\n");
+#  endif
+    return i;
+}
+#endif
+
 /* This routine handles any switches that can be given during run */
 
 char *
@@ -2263,24 +2297,8 @@ Perl_moreswitches(pTHX_ char *s)
     {	
 #ifdef DEBUGGING
 	forbid_setid("-D");
-	if (isALPHA(s[1])) {
-	    /* if adding extra options, remember to update DEBUG_MASK */
-	    static char debopts[] = "psltocPmfrxu HXDSTRJvC";
-	    char *d;
-
-	    for (s++; *s && (d = strchr(debopts,*s)); s++)
-		PL_debug |= 1 << (d - debopts);
-	}
-	else {
-	    PL_debug = atoi(s+1);
-	    for (s++; isDIGIT(*s); s++) ;
-	}
-#ifdef EBCDIC
-	if (DEBUG_p_TEST_ && ckWARN_d(WARN_DEBUGGING))
-	    Perl_warner(aTHX_ packWARN(WARN_DEBUGGING),
-		    "-Dp not implemented on this platform\n");
-#endif
-	PL_debug |= DEBUG_TOP_FLAG;
+	s++;
+	PL_debug = get_debug_opts(&s) | DEBUG_TOP_FLAG;
 #else /* !DEBUGGING */
 	if (ckWARN_d(WARN_DEBUGGING))
 	    Perl_warner(aTHX_ packWARN(WARN_DEBUGGING),
diff -up '19853.ORIG/pod/perlvar.pod' '19853-debug/pod/perlvar.pod'
Index: ./pod/perlvar.pod
--- ./pod/perlvar.pod	Wed Jun 25 22:29:05 2003
+++ ./pod/perlvar.pod	Fri Jun 27 21:47:55 2003
@@ -902,7 +902,8 @@ C<$^C = 1> is similar to calling C<B::mi
 =item $^D
 
 The current value of the debugging flags.  (Mnemonic: value of B<-D>
-switch.)
+switch.) May be read or set. Like its command-line equivalent, you can use
+numeric or symbolic values, eg C<$^D = 10> or C<$^D = "st">.
 
 =item $SYSTEM_FD_MAX
 
#### End of Patch data ####

#### ApplyPatch data follows ####
# Data version        : 1.0
# Date generated      : Fri Jun 27 21:47:59 2003
# Generated by        : makepatch 2.00_05
# Recurse directories : Yes
# Excluded files      : keywords\.h|warnings\.h|regnodes\.h|perlapi\.c|perlapi\.h|global\.sym|embedvar\.h|embed\.h|pod\/perlapi\.pod|pod\/perlintern\.pod|proto\.h
# v 'patchlevel.h' 4640 1056576558 33188
# p 'embed.fnc' 51059 1056744336 0100644
# p 'mg.c' 57871 1056746664 0100644
# p 'perl.c' 107010 1056746114 0100644
# p 'pod/perlvar.pod' 50935 1056746875 0100644
#### End of ApplyPatch data ####

#### End of Patch kit [created: Fri Jun 27 21:47:59 2003] ####
#### Patch checksum: 136 4099 35936 ####
#### Checksum: 154 4782 26655 ####

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About