B::Terse not outputting correct constants or variable names

p5pRT commented 21 years ago

Migrated from rt.perl.org#21261 (status was 'resolved')

Searchable as RT21261$

p5pRT commented 21 years ago

From philip.newton@datenrevision.de

Created by Philip.Newton@datenrevision.de

B::Terse does not give correct values for variable names or constants\, while previous versions did. (I'm not sure whether this is related to the fact that the newer version of Perl is compiled with ithreads and the older one I tried isn't. I also tried it on two version of ActivePerl; one based on 5.8.0 at home [Win98] and one based on 5.6.0 at work [NT] -- both also give the spurious results.)

Observe -

bad results:

lx pne/home/pne> perl -MO=Terse -e 'for(1..10) { $x = $_ * 10 }' LISTOP (0x814b110) leave [1] OP (0x814b138) enter COP (0x81af608) nextstate BINOP (0x81af5e0) leaveloop LOOP (0x81b0660) enteriter OP (0x814a6d0) null [3] UNOP (0x81b0618) null [141] OP (0x81b0640) pushmark SVOP (0x814b5e8) const SPECIAL #0 Nullsv SVOP (0x813dca8) const SPECIAL #0 Nullsv PADOP (0x81b05f8) gv 6 UNOP (0x8150f20) null LOGOP (0x81b03e8) and OP (0x81b03a8) iter LISTOP (0x81b05d0) lineseq COP (0x81b0590) nextstate BINOP (0x81b0568) sassign BINOP (0x81b0540) multiply [5] UNOP (0x81b04c8) null [15] PADOP (0x81b04a8) gvsv 4 SVOP (0x81b0520) const SPECIAL #0 Nullsv UNOP (0x81b0488) null [15] PADOP (0x81b0410) gvsv 3 OP (0x81b03c8) unstack COP (0x8150ee0) nextstate -e syntax OK

As you can see\, the variables "$x" and "$_" have been reduced to "gvsv 3" and "gvsv 4" in the loop\, and to "gv 6" in the foreach statement. Also\, the constants all show up as "SPECIAL #0 Nullsv".

Compare this with the output from an earlier perl:

lx pne/home/pne> /usr/bin/perl -MO=Terse -e 'for(1..10) { $x = $_ * 10 }' LISTOP (0x8182860) leave OP (0x8182888) enter COP (0x8182828) nextstate BINOP (0x8182800) leaveloop LOOP (0x81824d8) enteriter OP (0x8106b10) null [3] UNOP (0x8182718) null [141] OP (0x8182740) pushmark SVOP (0x8176590) const IV (0x80f64f0) 1 SVOP (0x81068b0) const IV (0x8100ef4) 10 SVOP (0x81826f8) gv GV (0x80f6400) *_ UNOP (0x81827e0) null LOGOP (0x81827b8) and OP (0x8176600) iter LISTOP (0x81826d0) lineseq COP (0x8182698) nextstate BINOP (0x8182670) sassign BINOP (0x8182648) multiply [3] UNOP (0x8182608) null [15] SVOP (0x81825e8) gvsv GV (0x80f6400) *_ SVOP (0x8182628) const IV (0x8175d44) 10 UNOP (0x81825c8) null [15] SVOP (0x8182518) gvsv GV (0x8175db0) *x OP (0x8182760) unstack COP (0x8182780) nextstate -e syntax OK

This properly contains *_\, *x\, 1\, and 10.

That perl is:

lx pne/home/pne> /usr/bin/perl -V Summary of my perl5 (revision 5.0 version 6 subversion 0) configuration: Platform: osname=linux\, osvers=2.4.6-3.1enterprise\, archname=i386-linux uname='linux stripples.devel.redhat.com 2.4.6-3.1enterprise #1 smp tue jul 24 14:03:17 edt 2001 i686 unknown ' config_args='-des -Doptimize=-O2 -march=i386 -mcpu=i686 -Dcc=gcc - Dcccdlflags=-fPIC -Dinstallprefix=/usr -Dprefix=/usr -Darchname=i386- linux -Dd_dosuid -Dd_semctl_semun -Di_db -Di_ndbm -Di_gdbm -Di_shadow - Di_syslog -Dman3ext=3pm -Uuselargefiles' hint=recommended\, useposix=true\, d_sigaction=define usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef useperlio=undef d_sfio=undef uselargefiles=undef use64bitint=undef use64bitall=undef uselongdouble=undef usesocks=undef Compiler: cc='gcc'\, optimize='-O2 -march=i386 -mcpu=i686'\, gccversion=2.96 20000731 (Red Hat Linux 7.1 2.96-96) cppflags='-fno-strict-aliasing -I/usr/local/include' ccflags ='-fno-strict-aliasing -I/usr/local/include' stdchar='char'\, d_stdstdio=define\, usevfork=false intsize=4\, longsize=4\, ptrsize=4\, doublesize=8 d_longlong=define\, longlongsize=8\, d_longdbl=define\, longdblsize=12 ivtype='long'\, ivsize=4\, nvtype='double'\, nvsize=8\, Off_t='off_t'\, lseeksize=4 alignbytes=4\, usemymalloc=n\, prototype=define Linker and Libraries: ld='gcc'\, ldflags =' -L/usr/local/lib' libpth=/usr/local/lib /lib /usr/lib libs=-lnsl -ldl -lm -lc -lcrypt libc=/lib/libc-2.2.4.so\, so=so\, useshrplib=false\, libperl=libperl.a Dynamic Linking: dlsrc=dl_dlopen.xs\, dlext=so\, d_dlsymun=undef\, ccdlflags='- rdynamic' cccdlflags='-fPIC'\, lddlflags='-shared -L/usr/local/lib'

Characteristics of this binary (from libperl): Compile-time options: Built under linux Compiled at Aug 9 2001 22:48:52 @INC: /usr/lib/perl5/5.6.0/i386-linux /usr/lib/perl5/5.6.0 /usr/lib/perl5/site_perl/5.6.0/i386-linux /usr/lib/perl5/site_perl/5.6.0 /usr/lib/perl5/site_perl .

Perl Info

``` Flags: category=library severity=medium Site configuration information for perl v5.8.0: Configured by pne at Sat Feb 1 16:59:24 CET 2003. Summary of my perl5 (revision 5.0 version 8 subversion 0) configuration: Platform: osname=linux, osvers=2.4.7-10smp, archname=i686-linux-thread-multi- 64int-ld uname='linux hamstux001 2.4.7-10smp #1 smp thu sep 6 17:09:31 edt 2001 i686 unknown ' config_args='-Accflags=-DPERL_Y2KWARN -Dcc=gcc -Dprefix=/home/pne - Uinstallusrbinperl -Duselargefiles -Duse64bitint -Duselongdouble - Dusethreads -Duseithreads' hint=recommended, useposix=true, d_sigaction=define usethreads=define use5005threads=undef useithreads=define usemultiplicity=define useperlio=define d_sfio=undef uselargefiles=define usesocks=undef use64bitint=define use64bitall=undef uselongdouble=define usemymalloc=n, bincompat5005=undef Compiler: cc='gcc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DPERL_Y2KWARN -fno- strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE - D_FILE_OFFSET_BITS=64 -I/usr/include/gdbm', optimize='-O2', cppflags='-D_REENTRANT -D_GNU_SOURCE -DPERL_Y2KWARN -fno-strict- aliasing -I/usr/local/include -I/usr/include/gdbm' ccversion='', gccversion='2.96 20000731 (Red Hat Linux 7.1 2.96- 98)', gccosandvers='' intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=12345678 d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12 ivtype='long long', ivsize=8, nvtype='long double', nvsize=12, Off_t='off_t', lseeksize=8 alignbytes=4, prototype=define Linker and Libraries: ld='gcc', ldflags =' -L/usr/local/lib' libpth=/usr/local/lib /lib /usr/lib libs=-lnsl -lgdbm -ldb -ldl -lm -lpthread -lc -lcrypt -lutil perllibs=-lnsl -ldl -lm -lpthread -lc -lcrypt -lutil libc=/lib/libc-2.2.4.so, so=so, useshrplib=false, libperl=libperl.a gnulibc_version='2.2.4' Dynamic Linking: dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='- rdynamic' cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib' Locally applied patches: @INC for perl v5.8.0: /home/pne/lib/perl5/5.8.0/i686-linux-thread-multi-64int-ld /home/pne/lib/perl5/5.8.0 /home/pne/lib/perl5/site_perl/5.8.0/i686-linux-thread-multi-64int- ld /home/pne/lib/perl5/site_perl/5.8.0 /home/pne/lib/perl5/site_perl . Environment for perl v5.8.0: HOME=/home/pne LANG=C LANGUAGE (unset) LC_CTYPE=de_DE.ISO8859-1 LD_LIBRARY_PATH=/usr/lib/X11:/users/dtm_vt/lib:/users/tegaron/bin:/appl/ tuxedo/8.0/lib:/appl/oracle/9.2.0.1.0/lib:/users/sde/sdeexe30/lib LOGDIR (unset) PATH=/home/pne/bin:/usr/local/bin:/bin:/usr/bin:/usr/X11R6/bin:/usr/bin: .:/usr/local/bin:/usr/bin/X11:/sbin:/home/pne/bin:/users/dtm_vt:/users/d tm_vt/bin:/users/dtm_vt/bin/vtmake:/users/tegaron/bin:/users/tegaron/uti l:/appl/tuxedo/8.0/bin:/appl/tuxedo/8.0/util:/appl/oracle/9.2.0.1.0/bin: /users/sde/sdeexe30/bin:/bin:/home/vt/testdaten/testscripte PERL_BADLANG (unset) SHELL=/bin/ksh -- Philip Newton ```

p5pRT commented 21 years ago

From @andk

On 17 Feb 2003 14:12:14 -0000\, Philip Newton (via RT) \perlbug\-followup@perl\.org said:

> I'm not sure whether this is related to the fact that the newer > version of Perl is compiled with ithreads and the older one I > tried isn't.

I just ran your one-liner on my collection of perls between 5.6.0 and bleadperl and found your bug confirmed on 270 different perls with ithreads on and not confirmed on 218 different perls with ithreads turned off. No counterexample available\, so this is clearly an issue with threads.

-- andreas

p5pRT commented 21 years ago

From smcc@mit.edu

"AK" == Andreas J Koenig \andreas\.koenig@anima\.de writes:

On 17 Feb 2003 14:12:14 -0000\, Philip Newton (via RT) \perlbug\-followup@perl\.org said:

PN> I'm not sure whether this is related to the fact that the newer PN> version of Perl is compiled with ithreads and the older one I PN> tried isn't.

AK> I just ran your one-liner on my collection of perls between 5.6.0 AK> and bleadperl and found your bug confirmed on 270 different perls AK> with ithreads on and not confirmed on 218 different perls with AK> ithreads turned off. No counterexample available\, so this is AK> clearly an issue with threads.

Yes\, specifically with GVs and constants moving to the scratchpad under ithreads. I have a certain familiarity with these changes from the analogous fixes that were necessary for B::Concise.

One workaround\, therefore\, is to say "-MO=Concise\,-terse" instead of "-MO=Terse". For the constants part of the fix\, you'll need a B::Concise from a recent bleadperl\, since that bug was fixed just recently.

It wouldn't be too hard to make the fixes to Terse\, though I don't think anyone has been putting much effort into maintaining it recently. It may be that the time has come to get rid of it. Replacing it with a wrapper around B::Concise is a little bit tricky because of the internal interfaces that some of the other B:: modules use\, but I don't think that's an insurmountable problem.

-- Stephen

p5pRT commented 21 years ago

From Philip.Newton@gmx.net

On Mon\, 17 Feb 2003 13:54:28 -0500\, smcc@mit.edu (Stephen McCamant) wrote:

One workaround\, therefore\, is to say "-MO=Concise\,-terse" instead of "-MO=Terse".

That doesn't work on my home machine (ActivePerl 804\, based on 5.8.0):

-MO=Concise\,-terse (excerpt):

: BINOP (0x15c37d0) sassign : BINOP (0x15c37f4) multiply [5] : UNOP (0x15c3838) null [15] : PADOP (0x15c3858) gvsv : SVOP (0x15c3818) const [9] SPECIAL Null : UNOP (0x15c3878) null [15] : PADOP (0x15c3898) gvsv

-MO=Terse (same excerpt):

: BINOP (0x15c19b4) sassign : BINOP (0x15c19d8) multiply [5] : UNOP (0x15c1a1c) null [15] : PADOP (0x15c1a3c) gvsv 4 : SVOP (0x15c19fc) const SPECIAL #0 Nullsv : UNOP (0x15c1a5c) null [15] : PADOP (0x15c1a7c) gvsv 3

Looks pretty much the same\, except that the "3" and "4" are gone\, and "#0 Nullsv" is spelled "Null".

Cheers\, Philip

p5pRT commented 21 years ago

From smcc@mit.edu

"PN" == Philip Newton \Philip\.Newton@gmx\.net writes:

PN> On Mon\, 17 Feb 2003 13:54:28 -0500\, smcc@mit.edu (Stephen McCamant) PN> wrote:

SMcC> One workaround\, therefore\, is to say "-MO=Concise\,-terse" instead of SMcC> "-MO=Terse".

PN> That doesn't work on my home machine (ActivePerl 804\, based on 5.8.0):

PN> -MO=Concise\,-terse (excerpt):

PN> : BINOP (0x15c37d0) sassign PN> : BINOP (0x15c37f4) multiply [5] PN> : UNOP (0x15c3838) null [15] PN> : PADOP (0x15c3858) gvsv PN> : SVOP (0x15c3818) const [9] SPECIAL Null PN> : UNOP (0x15c3878) null [15] PN> : PADOP (0x15c3898) gvsv

PN> -MO=Terse (same excerpt):

PN> : BINOP (0x15c19b4) sassign PN> : BINOP (0x15c19d8) multiply [5] PN> : UNOP (0x15c1a1c) null [15] PN> : PADOP (0x15c1a3c) gvsv 4 PN> : SVOP (0x15c19fc) const SPECIAL #0 Nullsv PN> : UNOP (0x15c1a5c) null [15] PN> : PADOP (0x15c1a7c) gvsv 3

PN> Looks pretty much the same\, except that the "3" and "4" are gone\, and PN> "#0 Nullsv" is spelled "Null".

Oops\, yes. For the const part\, I think I said in a part of my message that you didn't quote that that fix wasn't in the 5.8.0 version of B::Concise\, since I just fixed it a few weeks ago.

As for the GVs\, you point out a real problem. B::Concise had been changed to deal with the changes to where GVs were stored\, but only partially: PADOP was added as a type\, and GVs were recognized when they appeared in SVOPs\, as now happens without ithreads\, but no handling of printing PADOPs was added. I'm working on a patch for that now.

Here's a corresponding excerpt from the output from

./perl -Ilib -MO=Concise\,-terse -e 'for(1..10) { $x = $_ * 10 }'

with ithreads and my working source tree:

BINOP (0x81a36d8) sassign BINOP (0x81a37e0) multiply [5] UNOP (0x81a3760) null [15] PADOP (0x81a3698) gvsv GV (0x818bb6c) *_ SVOP (0x81a2ea0) const [9] IV (0x81a1bac) 10 UNOP (0x81a3620) null [15] PADOP (0x818f860) gvsv GV (0x81a1bb8) *x

-- Stephen

p5pRT commented 21 years ago

From smcc@mit.edu

"PN" == Philip Newton \Philip\.Newton@gmx\.net writes:

PN> On Mon\, 17 Feb 2003 13:54:28 -0500\, smcc@mit.edu (Stephen McCamant) PN> wrote:

SMcC> One workaround\, therefore\, is to say "-MO=Concise\,-terse" instead of SMcC> "-MO=Terse".

PN> That doesn't work on my home machine (ActivePerl 804\, based on PN> 5.8.0):

The attached patch should make both -MO=Concise and MO=Terse work in bleadperl\, by finally replacing B::Terse with a wrapper around B::Concise. Besides being usable from the command line\, the wrapper also supports the internal B::Terse entrypoints used by B::Showlex and the test suite. Supporting the B::OP::terse interface used by B::Bblock wasn't compatible with being able to find information from the pad\, so I've modified B::Bblock to call B::Concise directly. (There's a deprecated B::OP::terse that only works for OPs in the main program). The only change necessary to the terse.t test was to enable testing some things that work now. It also prints PADOPs correctly\, so GVs show up right under ithreads\, the other half of the original bug.

The patch also includes some other small B::Concise related fixes:

* Print large UVs correctly * Print hash references (as from UTF8 tr///) a bit better * Be more careful about pmreplroot\, which is even weirder under ithreads * Note that OP_RCATLINE is a PADOP under ithreads (a change to B.xs)

-- Stephen

Inline Patch

```diff --- perl-current/ext/B/B/Concise.pm 2003-02-11 15:54:45.000000000 -0500 +++ perl-changed/ext/B/B/Concise.pm 2003-02-17 19:16:09.000000000 -0500 @@ -8,12 +8,13 @@ use Exporter (); -our $VERSION = "0.54"; +our $VERSION = "0.55"; our @ISA = qw(Exporter); -our @EXPORT_OK = qw(set_style add_callback); +our @EXPORT_OK = qw(set_style set_style_standard add_callback + concise_cv concise_main); use B qw(class ppname main_start main_root main_cv cstring svref_2object - SVf_IOK SVf_NOK SVf_POK OPf_KIDS); + SVf_IOK SVf_NOK SVf_POK SVf_IVisUV OPf_KIDS); my %style = ("terse" => @@ -51,6 +52,11 @@ ($format, $gotofmt, $treefmt) = @_; } +sub set_style_standard { + my($name) = @_; + set_style(@{$style{$name}}); +} + sub add_callback { push @callbacks, @_; } @@ -69,6 +75,23 @@ } } +sub concise_main { + my($order) = @_; + sequence(main_start); + $curcv = main_cv; + if ($order eq "exec") { + return if class(main_start) eq "NULL"; + walk_exec(main_start); + } elsif ($order eq "tree") { + return if class(main_root) eq "NULL"; + print tree(main_root, 0); + } elsif ($order eq "basic") { + return if class(main_root) eq "NULL"; + walk_topdown(main_root, + sub { $_[0]->concise($_[1]) }, 0); + } +} + my $start_sym = "\e(0"; # "\cN" sometimes also works my $end_sym = "\e(B"; # "\cO" respectively @@ -85,7 +108,7 @@ my $order = "basic"; -set_style(@{$style{concise}}); +set_style_standard("concise"); sub compile { my @options = grep(/^-/, @_); @@ -131,19 +154,7 @@ } if (!@args or $do_main) { print "main program:\n" if $do_main; - sequence(main_start); - $curcv = main_cv; - if ($order eq "exec") { - return if class(main_start) eq "NULL"; - walk_exec(main_start); - } elsif ($order eq "tree") { - return if class(main_root) eq "NULL"; - print tree(main_root, 0); - } elsif ($order eq "basic") { - return if class(main_root) eq "NULL"; - walk_topdown(main_root, - sub { $_[0]->concise($_[1]) }, 0); - } + concise_main($order); } } } @@ -216,7 +227,7 @@ walk_topdown($kid, $sub, $level + 1); } } - if (class($op) eq "PMOP" and $ {$op->pmreplroot} + if (class($op) eq "PMOP" and $op->pmreplroot and $ {$op->pmreplroot} and $op->pmreplroot->isa("B::OP")) { walk_topdown($op->pmreplroot, $sub, $level + 1); } @@ -374,6 +385,8 @@ sub concise_sv { my($sv, $hr) = @_; $hr->{svclass} = class($sv); + $hr->{svclass} = "UV" + if $hr->{svclass} eq "IV" and $sv->FLAGS & SVf_IVisUV; $hr->{svaddr} = sprintf("%#x", $$sv); if ($hr->{svclass} eq "GV") { my $gv = $sv; @@ -395,9 +408,11 @@ } elsif ($sv->FLAGS & SVf_NOK) { $hr->{svval} .= $sv->NV; } elsif ($sv->FLAGS & SVf_IOK) { - $hr->{svval} .= $sv->IV; + $hr->{svval} .= $sv->int_value; } elsif ($sv->FLAGS & SVf_POK) { $hr->{svval} .= cstring($sv->PV); + } elsif (class($sv) eq "HV") { + $hr->{svval} .= 'HASH'; } return $hr->{svclass} . " " . $hr->{svval}; } @@ -438,7 +453,7 @@ } my $pmreplroot = $op->pmreplroot; my $pmreplstart; - if ($$pmreplroot && $pmreplroot->isa("B::GV")) { + if ($pmreplroot && $$pmreplroot && $pmreplroot->isa("B::GV")) { # with C<@stash_array = split(/pat/, str);>, # *stash_array is stored in pmreplroot. $h{arg} = "($precomp => \@" . $pmreplroot->NAME . ")"; @@ -477,6 +492,9 @@ } else { $h{arg} = "(" . concise_sv($op->sv, \%h) . ")"; } + } elsif ($h{class} eq "PADOP") { + my $sv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$op->padix]; + $h{arg} = "[" . concise_sv($sv, \%h) . "]"; } $h{seq} = $h{hyphseq} = seq($op); $h{seq} = "" if $h{seq} eq "-"; @@ -512,6 +530,30 @@ print concise_op($op, $level, $format); } +# B::OP::terse (see Terse.pm) now just calls this +sub b_terse { + my($op, $level) = @_; + + # This isn't necessarily right, but there's no easy way to get + # from an OP to the right CV. This is a limitation of the + # ->terse() interface style, and there isn't much to do about + # it. In particular, we can die in concise_op if the main pad + # isn't long enough, or has the wrong kind of entries, compared to + # the pad a sub was compiled with. The fix for that would be to + # make a backwards compatible "terse" format that never even + # looked at the pad, just like the old B::Terse. I don't think + # that's worth the effort, though. + $curcv = main_cv unless $curcv; + + if ($order eq "exec" and $lastnext and $$lastnext != $$op) { + my $h = {"seq" => seq($lastnext), "class" => class($lastnext), + "addr" => sprintf("%#x", $$lastnext)}; + print fmt_line($h, $style{"terse"}[1], $level+1); + } + $lastnext = $op->next; + print concise_op($op, $level, $style{"terse"}[0]); +} + sub tree { my $op = shift; my $level = shift; @@ -1006,11 +1048,14 @@ references to scalars, but it is unlikely that they will need to be changed or even used. +To switch back to one of the standard styles like C or +C, use C. + To see the output, call the subroutine returned by B in the same way that B does. =head1 AUTHOR -Stephen McCamant, C +Stephen McCamant, Esmcc@CSUA.Berkeley.EDUE. =cut --- perl-current/ext/B/B/Terse.pm 2001-11-15 20:43:01.000000000 -0500 +++ perl-changed/ext/B/B/Terse.pm 2003-02-17 19:09:53.000000000 -0500 @@ -1,42 +1,30 @@ package B::Terse; -our $VERSION = '1.00'; +our $VERSION = '1.01'; use strict; -use B qw(peekop class walkoptree walkoptree_exec walkoptree_slow - main_start main_root cstring svref_2object SVf_IVisUV); +use B qw(class); use B::Asmdata qw(@specialsv_name); +use B::Concise qw(concise_cv set_style_standard); +use Carp; sub terse { my ($order, $cvref) = @_; - my $cv = svref_2object($cvref); + set_style_standard("terse"); if ($order eq "exec") { - walkoptree_exec($cv->START, "terse"); + concise_cv('exec', $cvref); } else { - walkoptree_slow($cv->ROOT, "terse"); + concise_cv('basic', $cvref); } + } sub compile { - my $order = @_ ? shift : ""; - my @options = @_; - B::clearsym(); - if (@options) { - return sub { - my $objname; - foreach $objname (@options) { - $objname = "main::$objname" unless $objname =~ /::/; - eval "terse(\$order, \\&$objname)"; - die "terse($order, \\&$objname) failed: $@" if $@; - } - } - } else { - if ($order eq "exec") { - return sub { walkoptree_exec(main_start, "terse") } - } else { - return sub { walkoptree_slow(main_root, "terse") } - } - } + my @args = @_; + my $order = @args ? shift(@args) : ""; + $order = "-exec" if $order eq "exec"; + unshift @args, $order if $order ne ""; + B::Concise::compile("-terse", @args); } sub indent { @@ -44,102 +32,19 @@ return " " x $level; } +# Don't use this, at least on OPs in subroutines: it has no way of +# getting to the pad, and will give wrong answers or crash. sub B::OP::terse { - my ($op, $level) = @_; - my $targ = $op->targ; - $targ = ($targ > 0) ? " [$targ]" : ""; - print indent($level), peekop($op), $targ, "\n"; + carp "B::OP::terse is deprecated; use B::Concise instead"; + B::Concise::b_terse(@_); } -sub B::SVOP::terse { - my ($op, $level) = @_; - print indent($level), peekop($op), " "; - $op->sv->terse(0); -} - -sub B::PADOP::terse { - my ($op, $level) = @_; - print indent($level), peekop($op), " ", $op->padix, "\n"; -} - -sub B::PMOP::terse { - my ($op, $level) = @_; - my $precomp = $op->precomp; - print indent($level), peekop($op), - defined($precomp) ? " /$precomp/\n" : " (regexp not compiled)\n"; - -} - -sub B::PVOP::terse { - my ($op, $level) = @_; - print indent($level), peekop($op), " ", cstring($op->pv), "\n"; -} - -sub B::COP::terse { - my ($op, $level) = @_; - my $label = $op->label; - if ($label) { - $label = " label ".cstring($label); - } - print indent($level), peekop($op), $label || "", "\n"; -} - -sub B::PV::terse { - my ($sv, $level) = @_; - print indent($level); - printf "%s (0x%lx) %s\n", class($sv), $$sv, cstring($sv->PV); -} - -sub B::AV::terse { - my ($sv, $level) = @_; - print indent($level); - printf "%s (0x%lx) FILL %d\n", class($sv), $$sv, $sv->FILL; -} - -sub B::GV::terse { - my ($gv, $level) = @_; - my $stash = $gv->STASH->NAME; - if ($stash eq "main") { - $stash = ""; - } else { - $stash = $stash . "::"; - } - print indent($level); - printf "%s (0x%lx) *%s%s\n", class($gv), $$gv, $stash, $gv->SAFENAME; -} - -sub B::IV::terse { - my ($sv, $level) = @_; - print indent($level); - my $v = $sv->FLAGS & SVf_IVisUV ? "%u" : "%d"; - printf "%s (0x%lx) $v\n", class($sv), $$sv, $sv->int_value; -} - -sub B::NV::terse { - my ($sv, $level) = @_; - print indent($level); - printf "%s (0x%lx) %s\n", class($sv), $$sv, $sv->NV; -} - -sub B::RV::terse { - my ($rv, $level) = @_; - print indent($level); - printf "%s (0x%lx) %s\n", class($rv), $$rv, printref($rv); -} - -sub printref { - my $rv = shift; - my $rcl = class($rv->RV); - if ($rcl eq 'PV') { - return "\\" . cstring($rv->RV->$rcl); - } elsif ($rcl eq 'NV') { - return "\\" . $rv->RV->$rcl; - } elsif ($rcl eq 'IV') { - return sprintf "\\%" . ($rv->RV->FLAGS & SVf_IVisUV ? "u" : "d"), - $rv->RV->int_value; - } elsif ($rcl eq 'RV') { - return "\\" . printref($rv->RV); - } +sub B::SV::terse { + my($sv, $level) = (@_, 0); + my %info; + B::Concise::concise_sv($sv, \%info); + my $s = B::Concise::fmt_line(\%info, "#svclass~(?((#svaddr))?)~#svval", 0); + print indent($level), $s, "\n"; } sub B::NULL::terse { @@ -147,7 +52,7 @@ print indent($level); printf "%s (0x%lx)\n", class($sv), $$sv; } - + sub B::SPECIAL::terse { my ($sv, $level) = @_; print indent($level); @@ -168,10 +73,25 @@ =head1 DESCRIPTION -See F. +This version of B::Terse is really just a wrapper that calls B::Concise +with the B<-terse> option. It is provided for compatibility with old scripts +(and habits) but using B::Concise directly is now recommended instead. + +For compatiblilty with the old B::Terse, this module also adds a +method named C to B::OP and B::SV objects. The B::SV method is +largely compatible with the old one, though authors of new software +might be advised to choose a more user-friendly output format. The +B::OP C method, however, doesn't work well. Since B::Terse was +first written, much more information in OPs has migrated to the +scratchpad datastructure, but the C interface doesn't have any +way of getting to the correct pad. As a kludge, the new version will +always use the pad for the main program, but for OPs in subroutines +this will give the wrong answer or crash. =head1 AUTHOR -Malcolm Beattie, C +The original version of B::Terse was written by Malcolm Beattie, +Embeattie@sable.ox.ac.ukE. This wrapper was written by Stephen +McCamant, Esmcc@MIT.EDUE. =cut --- perl-current/ext/B/B/Bblock.pm 2001-12-15 13:15:36.000000000 -0500 +++ perl-changed/ext/B/B/Bblock.pm 2003-02-17 19:09:53.000000000 -0500 @@ -10,7 +10,7 @@ main_root main_start svref_2object OPf_SPECIAL OPf_STACKED ); -use B::Terse; +use B::Concise qw(concise_cv concise_main set_style_standard); use strict; my $bblock; @@ -64,8 +64,6 @@ } printf " %s\n", peekop($lastop); } - print "-------\n"; - walkoptree_exec($start, "terse"); } sub walk_bblocks_obj { @@ -140,10 +138,19 @@ $objname = "main::$objname" unless $objname =~ /::/; eval "walk_bblocks_obj(\\&$objname)"; die "walk_bblocks_obj(\\&$objname) failed: $@" if $@; + print "-------\n"; + set_style_standard("terse"); + eval "concise_cv('exec', \\&$objname)"; + die "concise_cv('exec', \\&$objname) failed: $@" if $@; } } } else { - return sub { walk_bblocks(main_root, main_start) }; + return sub { + walk_bblocks(main_root, main_start); + print "-------\n"; + set_style_standard("terse"); + concise_main("exec"); + }; } } --- perl-current/ext/B/B.xs 2002-12-01 21:09:03.000000000 -0500 +++ perl-changed/ext/B/B.xs 2003-02-17 19:09:53.000000000 -0500 @@ -95,7 +95,8 @@ return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP); #ifdef USE_ITHREADS - if (o->op_type == OP_GV || o->op_type == OP_GVSV || o->op_type == OP_AELEMFAST) + if (o->op_type == OP_GV || o->op_type == OP_GVSV || + o->op_type == OP_AELEMFAST || o->op_type == OP_RCATLINE) return OPc_PADOP; #endif --- perl-current/ext/B/t/terse.t 2002-05-30 10:40:21.000000000 -0400 +++ perl-changed/ext/B/t/terse.t 2003-02-17 19:31:03.000000000 -0500 @@ -5,7 +5,7 @@ @INC = '../lib'; } -use Test::More tests => 15; +use Test::More tests => 16; use_ok( 'B::Terse' ); @@ -33,7 +33,7 @@ # now build some regexes that should match the dumped ops my ($hex, $op) = ('$0x[a-f0-9]+$', '\s+\w+'); my %ops = map { $_ => qr/$_ $hex$op/ } - qw ( OP COP LOOP PMOP UNOP BINOP LOGOP LISTOP ); + qw ( OP COP LOOP PMOP UNOP BINOP LOGOP LISTOP PVOP ); # split up the output lines into individual ops (terse is, well, terse!) # use an array here so $_ is modifiable @@ -55,7 +55,9 @@ # XXX: # this tries to get at all tersified optypes in B::Terse -# if you add AV, NULL, PADOP, PVOP, or SPECIAL, add it to the regex above too +# if you can think of a way to produce AV, NULL, PADOP, or SPECIAL, +# add it to the regex above too. (PADOPs are currently only produced +# under ithreads, though). # use vars qw( $a $b ); sub bar { @@ -71,7 +73,7 @@ # this is awful, but it gives a PMOP my $boo = split('', $foo); - # PMOP + # PVOP, LOOP LOOP: for (1 .. 10) { last LOOP if $_ % 2; } @@ -83,17 +85,12 @@ $foo =~ s/(a)/$1/; } -SKIP: { - use Config; - skip("- B::Terse won't grok RVs under ithreads yet", 1) - if $Config{useithreads}; - # Schwern's example of finding an RV - my $path = join " ", map { qq["-I$_"] } @INC; - $path = '-I::lib -MMac::err=unix' if $^O eq 'MacOS'; - my $redir = $^O eq 'MacOS' ? '' : "2>&1"; - my $items = qx{$^X $path "-MO=Terse" -le "print \\42" $redir}; - like( $items, qr/RV $hex \\42/, 'RV' ); -} +# Schwern's example of finding an RV +my $path = join " ", map { qq["-I$_"] } @INC; +$path = '-I::lib -MMac::err=unix' if $^O eq 'MacOS'; +my $redir = $^O eq 'MacOS' ? '' : "2>&1"; +my $items = qx{$^X $path "-MO=Terse" -le "print \\42" $redir}; +like( $items, qr/RV $hex \\42/, 'RV' ); package TieOut; ```

p5pRT commented 21 years ago

From @hvds

Stephen McCamant \smcc@mit\.edu wrote: :The attached patch should make both -MO=Concise and MO=Terse work in :bleadperl\, by finally replacing B::Terse with a wrapper around :B::Concise. [...] :The patch also includes some other small B::Concise related fixes: : : * Print large UVs correctly : * Print hash references (as from UTF8 tr///) a bit better : * Be more careful about pmreplroot\, which is even weirder under : ithreads : * Note that OP_RCATLINE is a PADOP under ithreads (a change to B.xs)

Thanks\, applied as #18737.

:-Stephen McCamant\, C\smcc@CSUA\.Berkeley\.EDU :+Stephen McCamant\, E\lt>smcc@CSUA\.Berkeley\.EDUE\<gt.

Hmm\, I can imagine people pasting the words out of that and ending up trying to send mail to smcc@CSUA.Berkeley.EDUE.

I note that we currently have about an 80-20 mix of this style and another - E\lt>F\<smcc@CSUA\.Berkeley\.EDUE\ - which at least avoids that problem.

:+The original version of B::Terse was written by Malcolm Beattie\, :+E\lt>mbeattie@sable\.ox\.ac\.ukE\<gt. This wrapper was written by Stephen :+McCamant\, E\lt>smcc@MIT\.EDUE\<gt.

Split personality? :)

Hugo

p5pRT commented 21 years ago

From Philip.Newton@gmx.net

On Tue\, 18 Feb 2003 02:00:51 +0000\, hv@crypt.org wrote:

Stephen McCamant \smcc@mit\.edu wrote: :-Stephen McCamant\, C\smcc@CSUA\.Berkeley\.EDU :+Stephen McCamant\, E\lt>smcc@CSUA\.Berkeley\.EDUE\<gt. [snip] :+The original version of B::Terse was written by Malcolm Beattie\, :+E\lt>mbeattie@sable\.ox\.ac\.ukE\<gt. This wrapper was written by Stephen :+McCamant\, E\lt>smcc@MIT\.EDUE\<gt.

Split personality? :)

Nah\, probably just name-dropping prestigious IT places. I keep waiting for a Stanford address to pop up\, or maybe a Lucent/Bell Labs one :)

Cheers\, Philip

p5pRT commented 21 years ago

From @jhi

The patch was applied\, therefore I'm marking the problem ticket as resolved.

p5pRT commented 21 years ago

@jhi - Status changed from 'new' to 'resolved'

Perl / perl5