From 2b588c81530b97aff281cc3c12785f67166e2cb4 Mon Sep 17 00:00:00 2001 From: "H.Merijn Brand" Date: Fri, 26 Sep 2008 16:35:04 +0200 Subject: [PATCH] Added DDual () --- ChangeLog | 1 + DDumper.pm | 17 ++++++++++++-- DDumper.xs | 49 +++++++++++++++++++++++++++++++++++++--- MANIFEST | 1 + t/10_DDumper.t | 2 +- t/50_DDual.t | 71 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 135 insertions(+), 6 deletions(-) create mode 100644 t/50_DDual.t diff --git a/ChangeLog b/ChangeLog index 200a6b3..ba2d46c 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,6 +1,7 @@ 2008-09-25 0.12 - H.Merijn Brand * Start writing tests for DDump () + * Added DDual () 2008-09-25 0.11 - H.Merijn Brand diff --git a/DDumper.pm b/DDumper.pm index e7daa2c..16959bf 100644 --- a/DDumper.pm +++ b/DDumper.pm @@ -8,7 +8,7 @@ use DynaLoader (); use vars qw( $VERSION @ISA @EXPORT ); $VERSION = "0.12"; @ISA = qw( DynaLoader Exporter ); -@EXPORT = qw( DDumper DPeek DDump ); +@EXPORT = qw( DDumper DPeek DDump DDual ); $] >= 5.007003 and push @EXPORT, "DDump_IO"; bootstrap DDumper $VERSION; @@ -125,6 +125,8 @@ DDumper - Modified and extended debugging facilities print DDumper \%hash; # Same syntax as Data::Dumper + my ($pv, $iv, $nv, $rv, $magic) = DDual ($var [, 1]); + print DPeek \$var; my $dump = DDump $var; @@ -173,6 +175,17 @@ Example foo => 'egg' }; +=head2 DDual ($var [, $getmagic]) + +DDual will return the basic elements in a variable, guaranteeing that no +conversion takes place. This is very useful for dual-var variables, or +when checking is a variable has defined entries for a certain type of +scalar. For each Integer (IV), Double (NV), String (PV), and Reference (RV), +the current value of C<$var> is returned or undef if it is not set (yet). +The 5th element is an indicator if C<$var> has magic, which is B invoked +in the returned values, unless explicitly asked for with a true optional +second argument. + =head2 DPeek ($var) Playing with C, I found C, and it might be @@ -201,7 +214,7 @@ In void context, it behaves exactly like C. In scalar context, it returns what C would have printed. In list context, it returns a hash of the variable's properties. In this mode -you can pass an optional second argument that detemines the depth of digging. +you can pass an optional second argument that determines the depth of digging. Example diff --git a/DDumper.xs b/DDumper.xs index 81bf49a..b2e613e 100644 --- a/DDumper.xs +++ b/DDumper.xs @@ -1,12 +1,18 @@ -/* Copyright (c) 2007-2008 H.Merijn Brand. All rights reserved. +/* Copyright (c) 2008-2008 H.Merijn Brand. All rights reserved. * This program is free software; you can redistribute it and/or * modify it under the same terms as Perl itself. */ +#ifdef __cplusplus +extern "C" { +#endif #include #include #include #include "ppport.h" +#ifdef __cplusplus +} +#endif SV *_DDump (SV *sv) { @@ -40,21 +46,58 @@ SV *_DDump (SV *sv) MODULE = DDumper PACKAGE = DDumper -PROTOTYPES: DISABLE - void DPeek (sv) SV *sv + PROTOTYPE: $ PPCODE: ST (0) = newSVpv (Perl_sv_peek (aTHX_ sv), 0); XSRETURN (1); /* XS DPeek */ void +DDual (sv, ...) + SV *sv + + PROTOTYPE: $;$ + PPCODE: + if (items > 1 && SvGMAGICAL (sv) && SvTRUE (ST (1))) + mg_get (sv); + + if (SvPOK (sv) || SvPOKp (sv)) { + SV *xv = newSVpv (SvPVX (sv), 0); + if (SvUTF8 (sv)) SvUTF8_on (xv); + mPUSHs (xv); + } + else + PUSHs (&PL_sv_undef); + + if (SvIOK (sv) || SvIOKp (sv)) + mPUSHi (SvIV (sv)); + else + PUSHs (&PL_sv_undef); + + if (SvNOK (sv) || SvNOKp (sv)) + mPUSHn (SvNV (sv)); + else + PUSHs (&PL_sv_undef); + + if (SvROK (sv)) { + SV *xv = newSVsv (SvRV (sv)); + mPUSHs (xv); + } + else + PUSHs (&PL_sv_undef); + + mPUSHi (SvMAGICAL (sv) >> 21); + /* XS DDual */ + +void DDump_XS (sv) SV *sv + PROTOTYPE: $ PPCODE: SV *dd = _DDump (sv); diff --git a/MANIFEST b/MANIFEST index 179bcfd..de3b301 100644 --- a/MANIFEST +++ b/MANIFEST @@ -14,4 +14,5 @@ t/30_DDump-s.t Tests for DDump () returning string using _XS t/31_DDump-s.t Tests for DDump () returning string using _IO t/40_DDump-h.t Tests for DDump () returning hash using _XS t/41_DDump-h.t Tests for DDump () returning hash using _IO +t/50_DDual.t Tests for DDual () examples/ddumper.pl show the use diff --git a/t/10_DDumper.t b/t/10_DDumper.t index 3f51cba..f6ea4c7 100644 --- a/t/10_DDumper.t +++ b/t/10_DDumper.t @@ -7,7 +7,7 @@ use Test::More tests => 42; BEGIN { use_ok "DDumper"; - plan skip_all => "Cannot load DDumper" if $@; + die "Cannot load DDumper\n" if $@; # BAIL_OUT not avail in old Test::More } my ($dump, $var) = ("", ""); diff --git a/t/50_DDual.t b/t/50_DDual.t new file mode 100644 index 0000000..a669fde --- /dev/null +++ b/t/50_DDual.t @@ -0,0 +1,71 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 69; + +use DDumper; + +my %special = ( 9 => "\\t", 10 => "\\n", 13 => "\\r" ); +sub neat +{ + my $neat = $_[0]; + defined $neat or return "undef"; + my $ref = ref $neat ? "\\" : "" and $neat = $$neat; + join "", $ref, map { + my $cp = ord $_; + $cp >= 0x20 && $cp <= 0x7e + ? $_ + : $special{$cp} || sprintf "\\x{%02x}", $cp + } split m//, $neat; + } # neat + +foreach my $test ( + [ undef, undef, undef, undef, undef, 0, undef ], + [ 0, undef, 0, undef, undef, 0, undef ], + [ 1, undef, 1, undef, undef, 0, undef ], + [ 0.5, undef, undef, 0.5, undef, 0, 0 ], + [ "", "", undef, undef, undef, 0, 0 ], + [ \0, undef, undef, undef, 0, 0, undef ], + [ \"a", undef, undef, undef, "a", 0, undef ], + ) { + (undef, my @exp) = @$test; + my $in = neat ($test->[0]); + ok (my @v = DDual ($test->[0]), "DDual ($in)"); + is (scalar @v, 5, "5 elements"); + is ($v[0], $exp[0], "PV $in ".DPeek ($v[0])); + is ($v[1], $exp[1], "IV $in ".DPeek ($v[1])); + is ($v[2], $exp[2], "NV $in ".DPeek ($v[2])); + is ($v[3], $exp[3], "RV $in ".DPeek ($v[3])); + is ($v[4], $exp[4], "MG $in ".DPeek ($v[4])); + + defined $v[1] and next; + { no warnings; + my $x = 0 + $test->[0]; + } + TODO: { local $TODO = "Do all perl versions upgrade?"; + ok (@v = DDual ($test->[0]), "DDual ($in + 0)"); + is ($v[1], $exp[5], "IV $in ".DPeek ($v[1])); + } + } + +TODO: { local $TODO = "How magic is \$? accross perl versions?"; + my @m = DDual ($?); + is ($m[4], 3, "\$? has magic"); + is ($m[0], undef, "PV \$? w/o get"); + is ($m[1], undef, "IV \$? w/o get"); + is ($m[2], undef, "NV \$? w/o get"); + is ($m[3], undef, "RV \$? w/o get"); + } + +TODO: { local $TODO = "How magic is \$? accross perl versions?"; + my @m = DDual ($?, 1); + is ($m[4], 3, "\$? has magic"); + is ($m[0], undef, "PV \$? w/ get"); + is ($m[1], 0, "IV \$? w/ get"); + is ($m[2], undef, "NV \$? w/ get"); + is ($m[3], undef, "RV \$? w/ get"); + } + +1; -- 2.11.4.GIT