Back out the mauve module and related changes
authorFlorian Ragwitz <rafl@debian.org>
Sun, 5 Sep 2010 18:30:54 +0000 (20:30 +0200)
committerFlorian Ragwitz <rafl@debian.org>
Thu, 16 Sep 2010 13:53:51 +0000 (15:53 +0200)
It's was intended as a temporary namespace only, and we really don't want to
ship it in any release until we've figured out what it should really look like.

This reverts commit 05c0d6bbe3ec5cc9af99d105b8648ad02ed7cc95,
  "add sv_reftype_len() and make sv_reftype() be a wrapper for it"
commit 792477b9c2e4c75cb03d07bd6d25dc7e1fdf448e,
 "create the "mauve" temporary namespace for things like reftype"
commit 8df6b97c1de8326d50ac9c8cae4bf716393b45bb,
  "mauve.t needs access to %Config, make sure it's available"
commit cfe9162d0d593cd12a979c73df82c7509b324343,
 "use more efficient sv_reftype_len() interface"
and commit 47b13905e23c2a72acdde8bb4669e25e5eaefec4
  "add more tests to lib/mauve.t so it tests also that mauve::reftype can return "LVALUE""

There's a `mauve' branch still containing all the code for the temporary mauve
namespace. That should be used to work on it until it's mostly ready to be
released, and only then merged to blead. Alternatively, it should be deleted if
another way to provide mauve's features in the core is found.

MANIFEST
Porting/Maintainers.pl
embed.fnc
embed.h
global.sym
lib/mauve.pm [deleted file]
lib/mauve.t [deleted file]
pp.c
proto.h
sv.c
universal.c

index 5492753..c19638e 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3612,8 +3612,6 @@ lib/less.t                        See if less support works
 lib/locale.pm                  For "use locale"
 lib/locale.t                   See if locale support works
 lib/look.pl                    A "look" equivalent
-lib/mauve.pm                   Temporary namespace for new built in "reftype" pseduo keyword (and friends)
-lib/mauve.t                    tests for "mauve" namespace for new built in "reftype" pseduo keyword (and friends)
 lib/Net/hostent.pm             By-name interface to Perl's builtin gethost*
 lib/Net/hostent.t              See if Net::hostent works
 lib/Net/netent.pm              By-name interface to Perl's builtin getnet*
index c27b6eb..926af50 100755 (executable)
@@ -914,6 +914,7 @@ use File::Glob qw(:case);
                           ],
        'UPSTREAM'      => 'cpan',
        },
+
     'Memoize' =>
        {
        'MAINTAINER'    => 'mjd',
@@ -1816,7 +1817,6 @@ use File::Glob qw(:case);
                                lib/less.{pm,t}
                                lib/locale.{pm,t}
                                lib/look.pl
-                                lib/mauve.{pm,t}
                                lib/open.{pm,t}
                                lib/open2.pl
                                lib/open3.pl
index 0f666d7..995f8f0 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1208,7 +1208,6 @@ Apd       |char*  |sv_pvbyten_force|NN SV *const sv|NULLOK STRLEN *const lp
 Apd    |char*  |sv_recode_to_utf8      |NN SV* sv|NN SV *encoding
 Apd    |bool   |sv_cat_decode  |NN SV* dsv|NN SV *encoding|NN SV *ssv|NN int *offset \
                                |NN char* tstr|int tlen
-ApdR   |const char*    |sv_reftype_len |NN const SV *const sv|const int ob|NN STRLEN *const ret_len
 ApdR   |const char*    |sv_reftype     |NN const SV *const sv|const int ob
 Apd    |void   |sv_replace     |NN SV *const sv|NN SV *const nsv
 Apd    |void   |sv_report_used
diff --git a/embed.h b/embed.h
index 9e43d48..e498de7 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define sv_pvbyten_force       Perl_sv_pvbyten_force
 #define sv_recode_to_utf8      Perl_sv_recode_to_utf8
 #define sv_cat_decode          Perl_sv_cat_decode
-#define sv_reftype_len         Perl_sv_reftype_len
 #define sv_reftype             Perl_sv_reftype
 #define sv_replace             Perl_sv_replace
 #define sv_report_used         Perl_sv_report_used
 #define sv_pvbyten_force(a,b)  Perl_sv_pvbyten_force(aTHX_ a,b)
 #define sv_recode_to_utf8(a,b) Perl_sv_recode_to_utf8(aTHX_ a,b)
 #define sv_cat_decode(a,b,c,d,e,f)     Perl_sv_cat_decode(aTHX_ a,b,c,d,e,f)
-#define sv_reftype_len(a,b,c)  Perl_sv_reftype_len(aTHX_ a,b,c)
 #define sv_reftype(a,b)                Perl_sv_reftype(aTHX_ a,b)
 #define sv_replace(a,b)                Perl_sv_replace(aTHX_ a,b)
 #define sv_report_used()       Perl_sv_report_used(aTHX)
index 4ff4ea0..4670985 100644 (file)
@@ -596,7 +596,6 @@ Perl_sv_pvutf8n_force
 Perl_sv_pvbyten_force
 Perl_sv_recode_to_utf8
 Perl_sv_cat_decode
-Perl_sv_reftype_len
 Perl_sv_reftype
 Perl_sv_replace
 Perl_sv_report_used
diff --git a/lib/mauve.pm b/lib/mauve.pm
deleted file mode 100644 (file)
index e94a412..0000000
+++ /dev/null
@@ -1,161 +0,0 @@
-package mauve;
-use base qw/Exporter/;
-@EXPORT_OK=qw(reftype refaddr blessed isweak weaken);
-1;
-# mauve routines are installed from universal.c
-__END__
-
-=head1 NAME
-
-mauve - utilities for introspecting properties of scalar variables
-
-=head1 SYNOPSIS
-
-    # mauve routines are "always loaded"
-    my $type  = mauve::reftype($var);
-    my $addr  = mauve::refaddr($var);
-    my $class = mauve::blessed($var);
-
-    my $ref= \@foo;
-    mauve::weaken($ref);
-    my $isweak= mauve::isweak($ref);
-
-    # import mauve routines into your namespace
-    use mauve qw(reftype refaddr blessed weaken isweak);
-
-=head1 DESCRIPTION
-
-The C<mauve> namespace is a perl internals reserved namespace for utility 
-routines relating to scalar variables. These routines are closely related
-to the like named routines in Scalar::Util except that they are always loaded
-and where it makes sense, return FALSE instead of 'undef'.
-
-=head2 reftype SCALAR
-
-Returns false if the argument is not a reference, otherwise returns the
-reference type, which will be one of the following values:
-
-=over 4
-
-=item VSTRING
-
-Has special v-string magic
-
-=item REF
-
-Is a reference to another ref (C<< $$ref >>)
-
-=item SCALAR
-
-Is a reference to a scalar (C<< $$scalar >>)
-
-=item LVALUE
-
-An lvalue reference - B<NOTE>, tied lvalues appear to be of type C<SCALAR>
-for backwards compatibility reasons
-
-=item ARRAY
-
-An array reference (C<< @$array >>)
-
-=item HASH
-
-A hash reference (C<< %$hash >>)
-
-=item CODE
-
-A subroutine reference (C<< $code->() >>)
-
-=item GLOB
-
-A reference to a glob (C<< *$glob >>)
-
-=item FORMAT
-
-A format reference (C<< *IO{FORMAT} >>)
-
-=item IO
-
-An IO reference (C<< *STDOUT{IO} >>)
-
-=item BIND
-
-A bind reference
-
-=item REGEXP
-
-An executable regular expression (C<< qr/../ >>)
-
-=item UNKNOWN
-
-This should never be seen
-
-=back
-
-=head2 refaddr SCALAR
-
-Returns false if the argument is not a reference, otherwise returns the 
-address of the reference as an unsigned integer.
-
-=head2 blessed SCALAR
-
-Returns false if the argument is not a blessed reference, otherwise returns
-the package name the reference was blessed into.
-
-=head2 weaken REF
-
-REF will be turned into a weak reference. This means that it will not
-hold a reference count on the object it references. Also when the reference
-count on that object reaches zero, REF will be set to undef.
-
-This is useful for keeping copies of references , but you don't want to
-prevent the object being DESTROY-ed at its usual time.
-
-    {
-      my $var;
-      $ref = \$var;
-      weaken($ref);                     # Make $ref a weak reference
-    }
-    # $ref is now undef
-
-Note that if you take a copy of a scalar with a weakened reference,
-the copy will be a strong reference.
-
-    my $var;
-    my $foo = \$var;
-    weaken($foo);                       # Make $foo a weak reference
-    my $bar = $foo;                     # $bar is now a strong reference
-
-This may be less obvious in other situations, such as C<grep()>, for instance
-when grepping through a list of weakened references to objects that may have
-been destroyed already:
-
-    @object = grep { defined } @object;
-
-This will indeed remove all references to destroyed objects, but the remaining
-references to objects will be strong, causing the remaining objects to never
-be destroyed because there is now always a strong reference to them in the
-@object array.
-
-=head2 isweak EXPR
-
-If EXPR is a scalar which is a weak reference the result is true.
-
-    $ref  = \$foo;
-    $weak = isweak($ref);               # false
-    weaken($ref);
-    $weak = isweak($ref);               # true
-
-B<NOTE>: Copying a weak reference creates a normal, strong, reference.
-
-    $copy = $ref;
-    $weak = isweak($copy);              # false
-
-=head1 SEE ALSO
-
-L<Scalar::Util>
-
-=cut
-
-
-
diff --git a/lib/mauve.t b/lib/mauve.t
deleted file mode 100644 (file)
index c956c07..0000000
+++ /dev/null
@@ -1,380 +0,0 @@
-#!./perl
-
-use Test::More tests => 32 + 60 + 12 + 22;
-
-use mauve qw(refaddr reftype blessed weaken isweak);
-use vars qw($t $y $x *F $v $r $never_blessed);
-use Symbol qw(gensym);
-use Config;
-
-# Ensure we do not trigger any tied methods
-tie *F, 'MyTie';
-
-my $i = 1;
-foreach $v (undef, 10, 'string') {
-  is(refaddr($v), !1, "not " . (defined($v) ? "'$v'" : "undef"));
-}
-
-foreach $r ({}, \$t, [], \*F, sub {}) {
-  my $n = "refaddr $r";
-  $n =~ /0x(\w+)/;
-  my $addr = do { local $^W; hex $1 };
-  my $before = ref($r);
-  is( refaddr($r), $addr, $n);
-  is( ref($r), $before, $n);
-
-  my $obj = bless $r, 'FooBar';
-  is( refaddr($r), $addr, "blessed with overload $n");
-  is( ref($r), 'FooBar', $n);
-}
-
-{
-  my $z = '77';
-  my $y = \$z;
-  my $a = '78';
-  my $b = \$a;
-  tie my %x, 'Hash3', {};
-  $x{$y} = 22;
-  $x{$b} = 23;
-  my $xy = $x{$y};
-  my $xb = $x{$b};
-  ok(ref($x{$y}));
-  ok(ref($x{$b}));
-  ok(refaddr($xy) == refaddr($y));
-  ok(refaddr($xb) == refaddr($b));
-  ok(refaddr($x{$y}));
-  ok(refaddr($x{$b}));
-}
-{
-  my $z = bless {}, '0';
-  ok(refaddr($z));
-  @{"0::ISA"} = qw(FooBar);
-  my $a = {};
-  my $r = refaddr($a);
-  $z = bless $a, '0';
-  ok(refaddr($z) > 10);
-  is(refaddr($z),$r,"foo");
-}
-{
-
-    my $HAVE_RE = 5.011 <= $];
-    my $RE = $HAVE_RE ? 'REGEXP' : 'SCALAR';
-    my($m,@m,%m);
-    format STDOUT = # do not indent the lone dot in next line
-.
-    @test = (
-     [ 0, !1,        1,                 'number'        ],
-     [ 0, !1,        'A',               'string'        ],
-     [ 0, !1,        *::t,              'glob'          ],
-     [ 1, HASH    => {},                'HASH ref'      ],
-     [ 1, HASH    => \%::t,             'HASH ref'      ],
-     [ 1, HASH    => \%m,               'HASH ref'      ],
-     [ 1, ARRAY   => [],                'ARRAY ref'     ],
-     [ 1, ARRAY   => \@::t,             'ARRAY ref'     ],
-     [ 1, ARRAY   => \@m,               'ARRAY ref'     ],
-     [ 0, SCALAR  => \1,                'SCALAR ref'    ],
-     [ 1, SCALAR  => \$t,               'SCALAR ref'    ],
-     [ 1, SCALAR  => \$m,               'SCALAR ref'    ],
-     [ 1, REF     => \(\$t),            'REF ref'       ],
-     [ 1, REF     => \[],               'REF ref'       ],
-     [ 1, LVALUE  => \substr("",0),     'LVALUE ref'    ],
-     [ 0, VSTRING => \v1.0.0,           'VSTRING ref'   ],
-     [ 1, VSTRING => \(my $v = v1.0.0), 'VSTRING ref'   ],
-     [ 1, GLOB    => \*F,               'tied GLOB ref' ],
-     [ 1, GLOB    => gensym,            'GLOB ref'      ],
-     [ 1, CODE    => sub {},            'CODE ref'      ],
-     [ 1, IO      => *STDIN{IO},        'IO ref'        ],
-     [ 1, FORMAT  => *STDOUT{FORMAT},   'FORMAT ref'    ],
-     [ 1, $RE     => qr/x/,             'REGEXP'        ],
-     [ 0, !1,        ${qr//},           'derefed regex' ],
-    );
-
-    foreach $test (@test) {
-      my($writable,$type,$what, $n) = @$test;
-
-      SKIP: {
-      if ($n =~ /derefed regex/i && !$HAVE_RE) {
-        skip "regexes are not scalar references in perl < 5.011", 1;
-      }
-
-      is( reftype($what), $type, "reftype: $n");
-      next unless $writable;
-
-      bless $what, "ABC";
-      is( reftype($what), $type, "reftype: blessed $n");
-
-      bless $what, "0";
-      is( reftype($what), $type, "reftype: blessed to false $n");
-      }
-    }
-}
-{
-    is(blessed(undef),"",      'undef is not blessed');
-    is(blessed(1),"",          'Numbers are not blessed');
-    is(blessed('A'),"",        'Strings are not blessed');
-    is(blessed({}),"", 'blessed: Unblessed HASH-ref');
-    is(blessed([]),"", 'blessed: Unblessed ARRAY-ref');
-    is(blessed(\$never_blessed),"",    'blessed: Unblessed SCALAR-ref');
-
-    $x = bless [], "ABC::\0::\t::\n::ABC";
-    is(blessed($x), "ABC::\0::\t::\n::ABC",    'blessed ARRAY-ref');
-
-    $x = bless [], "ABC";
-    is(blessed($x), "ABC",     'blessed ARRAY-ref');
-
-    $x = bless {}, "DEF";
-    is(blessed($x), "DEF",     'blessed HASH-ref');
-
-    $x = bless {}, "0";
-    cmp_ok(blessed($x), "eq", "0",     'blessed HASH-ref');
-
-    {
-      my $depth;
-      {
-        no warnings 'redefine';
-        *UNIVERSAL::can = sub { die "Burp!" if ++$depth > 2; blessed(shift) };
-      }
-      $x = bless {}, "DEF";
-      is(blessed($x), "DEF", 'recursion of UNIVERSAL::can');
-    }
-
-    {
-      my $obj = bless [], "Broken";
-      is( blessed($obj), "Broken", "blessed on broken isa() and can()" );
-    }
-}
-{
-    if (0) {
-      require Devel::Peek;
-      Devel::Peek->import('Dump');
-    }
-    else {
-      *Dump = sub {};
-    }
-
-
-    if(1) {
-
-        my ($y,$z);
-
-#
-# Case 1: two references, one is weakened, the other is then undef'ed.
-#
-
-        {
-                my $x = "foo";
-                $y = \$x;
-                $z = \$x;
-        }
-        print "# START\n";
-        Dump($y); Dump($z);
-
-        ok( ref($y) and ref($z));
-
-        print "# WEAK:\n";
-        weaken($y);
-        Dump($y); Dump($z);
-
-        ok( ref($y) and ref($z));
-
-        print "# UNDZ:\n";
-        undef($z);
-        Dump($y); Dump($z);
-
-        ok( not (defined($y) and defined($z)) );
-
-        print "# UNDY:\n";
-        undef($y);
-        Dump($y); Dump($z);
-
-        ok( not (defined($y) and defined($z)) );
-
-        print "# FIN:\n";
-        Dump($y); Dump($z);
-
-
-#
-# Case 2: one reference, which is weakened
-#
-
-        print "# CASE 2:\n";
-
-        {
-                my $x = "foo";
-                $y = \$x;
-        }
-
-        ok( ref($y) );
-        print "# BW: \n";
-        Dump($y);
-        weaken($y);
-        print "# AW: \n";
-        Dump($y);
-        ok( not defined $y  );
-
-        print "# EXITBLOCK\n";
-    }
-
-#
-# Case 3: a circular structure
-#
-
-    my $flag = 0;
-    {
-            my $y = bless {}, 'Dest';
-            Dump($y);
-            print "# 1: $y\n";
-            $y->{Self} = $y;
-            Dump($y);
-            print "# 2: $y\n";
-            $y->{Flag} = \$flag;
-            print "# 3: $y\n";
-            weaken($y->{Self});
-            print "# WKED\n";
-            ok( ref($y) );
-            print "# VALS: HASH ",$y,"   SELF ",\$y->{Self},"  Y ",\$y,
-                    "    FLAG: ",\$y->{Flag},"\n";
-            print "# VPRINT\n";
-    }
-    print "# OUT $flag\n";
-    ok( $flag == 1 );
-
-    print "# AFTER\n";
-
-    undef $flag;
-
-    print "# FLAGU\n";
-
-#
-# Case 4: a more complicated circular structure
-#
-
-    $flag = 0;
-    {
-            my $y = bless {}, 'Dest';
-            my $x = bless {}, 'Dest';
-            $x->{Ref} = $y;
-            $y->{Ref} = $x;
-            $x->{Flag} = \$flag;
-            $y->{Flag} = \$flag;
-            weaken($x->{Ref});
-    }
-    ok( $flag == 2 );
-
-#
-# Case 5: deleting a weakref before the other one
-#
-
-    my ($y,$z);
-    {
-            my $x = "foo";
-            $y = \$x;
-            $z = \$x;
-    }
-
-    print "# CASE5\n";
-    Dump($y);
-
-    weaken($y);
-    Dump($y);
-    undef($y);
-
-    ok( not defined $y);
-    ok( ref($z) );
-
-
-#
-# Case 6: test isweakref
-#
-
-    $a = 5;
-    ok(!isweak($a));
-    $b = \$a;
-    ok(!isweak($b));
-    weaken($b);
-    ok(isweak($b));
-    $b = \$a;
-    ok(!isweak($b));
-
-    my $x = {};
-    weaken($x->{Y} = \$a);
-    ok(isweak($x->{Y}));
-    ok(!isweak($x->{Z}));
-
-#
-# Case 7: test weaken on a read only ref
-#
-
-    SKIP: {
-        # Doesn't work for older perls, see bug [perl #24506]
-        skip("Test does not work with perl < 5.8.3", 5) if $] < 5.008003;
-
-        # in a MAD build, constants have refcnt 2, not 1
-        skip("Test does not work with MAD", 5) if exists $Config{mad};
-
-        $a = eval '\"hello"';
-        ok(ref($a)) or print "# didn't get a ref from eval\n";
-        $b = $a;
-        eval{weaken($b)};
-        # we didn't die
-        ok($@ eq "") or print "# died with $@\n";
-        ok(isweak($b));
-        ok($$b eq "hello") or print "# b is '$$b'\n";
-        $a="";
-        ok(not $b) or print "# b didn't go away\n";
-    }
-}
-
-package Broken;
-sub isa { die };
-sub can { die };
-
-package FooBar;
-
-use overload  '0+' => sub { 10 },
-               '+' => sub { 10 + $_[1] },
-               '"' => sub { "10" };
-
-package MyTie;
-
-sub TIEHANDLE { bless {} }
-sub DESTROY {}
-
-sub AUTOLOAD {
-  warn "$AUTOLOAD called";
-  exit 1; # May be in an eval
-}
-
-package Hash3;
-
-use Scalar::Util qw(refaddr);
-
-sub TIEHASH
-{
-       my $pkg = shift;
-       return bless [ @_ ], $pkg;
-}
-sub FETCH
-{
-       my $self = shift;
-       my $key = shift;
-       my ($underlying) = @$self;
-       return $underlying->{refaddr($key)};
-}
-sub STORE
-{
-       my $self = shift;
-       my $key = shift;
-       my $value = shift;
-       my ($underlying) = @$self;
-       return ($underlying->{refaddr($key)} = $key);
-}
-
-
-
-package Dest;
-
-sub DESTROY {
-       print "# INCFLAG\n";
-       ${$_[0]{Flag}} ++;
-}
diff --git a/pp.c b/pp.c
index 78ed286..2ee6049 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -559,7 +559,6 @@ PP(pp_ref)
     dVAR; dSP; dTARGET;
     const char *pv;
     SV * const sv = POPs;
-    STRLEN len;
 
     if (sv)
        SvGETMAGIC(sv);
@@ -567,8 +566,8 @@ PP(pp_ref)
     if (!sv || !SvROK(sv))
        RETPUSHNO;
 
-    pv = sv_reftype_len(SvRV(sv),TRUE,&len);
-    PUSHp(pv, len);
+    pv = sv_reftype(SvRV(sv),TRUE);
+    PUSHp(pv, strlen(pv));
     RETURN;
 }
 
diff --git a/proto.h b/proto.h
index e581699..4c7fb3d 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -3514,13 +3514,6 @@ PERL_CALLCONV bool       Perl_sv_cat_decode(pTHX_ SV* dsv, SV *encoding, SV *ssv, int
 #define PERL_ARGS_ASSERT_SV_CAT_DECODE \
        assert(dsv); assert(encoding); assert(ssv); assert(offset); assert(tstr)
 
-PERL_CALLCONV const char*      Perl_sv_reftype_len(pTHX_ const SV *const sv, const int ob, STRLEN *const ret_len)
-                       __attribute__warn_unused_result__
-                       __attribute__nonnull__(pTHX_1)
-                       __attribute__nonnull__(pTHX_3);
-#define PERL_ARGS_ASSERT_SV_REFTYPE_LEN        \
-       assert(sv); assert(ret_len)
-
 PERL_CALLCONV const char*      Perl_sv_reftype(pTHX_ const SV *const sv, const int ob)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(pTHX_1);
diff --git a/sv.c b/sv.c
index b40fb45..1f7c760 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -8612,112 +8612,23 @@ Perl_sv_pvutf8n_force(pTHX_ SV *const sv, STRLEN *const lp)
 }
 
 /*
-=for apidoc sv_reftype_len
-
-Returns a string describing what type of item the SV is a reference to,
-storing the length of the string in *ret_len.
-
-If 'ob' is true and the item is an "object" returns the class name
-instead of the underlying type.
-
-Possible return values are:
-
-=over 4
-
-=item VSTRING
-
-Has special v-string magic
-
-=item REF
-
-Is a reference to another ref (C<< $$ref >>)
-
-=item SCALAR
-
-Is a reference to a scalar (C<< $$scalar >>)
-
-=item LVALUE
-
-An lvalue reference - B<NOTE>, tied lvalues appear to be of type C<SCALAR>
-for backwards compatibility reasons
-
-=item ARRAY
-
-An array reference (C<< @$array >>)
-
-=item HASH
-
-A hash reference (C<< %$hash >>)
-
-=item CODE
-
-A subroutine reference (C<< $code->() >>)
-
-=item GLOB
-
-A reference to a glob (C<< *$glob >>)
-
-=item FORMAT
-
-A format reference (C<< *IO{FORMAT} >>)
-
-=item IO
-
-An IO reference (C<< *STDOUT{IO} >>)
-
-=item BIND
-
-A bind reference
-
-=item REGEXP
-
-An executable regular expression (C<< qr/../ >>)
-
-=item UNKNOWN
-
-This should never be seen
+=for apidoc sv_reftype
 
-=back
+Returns a string describing what the SV is a reference to.
 
 =cut
 */
 
-
 const char *
-Perl_sv_reftype_len(pTHX_ const SV *const sv, const int ob, STRLEN *const ret_len)
+Perl_sv_reftype(pTHX_ const SV *const sv, const int ob)
 {
-    PERL_ARGS_ASSERT_SV_REFTYPE_LEN;
-    assert(ret_len!=NULL);
+    PERL_ARGS_ASSERT_SV_REFTYPE;
 
-    /* The fact that I don't need to downcast to char * everywhere, only in ?: (not used anymore)
+    /* The fact that I don't need to downcast to char * everywhere, only in ?:
        inside return suggests a const propagation bug in g++.  */
-
-    /*
-     *  NOTE:
-     *
-     *  This code is formatted so that the following command spits out a POD list of the
-     *  legal "reftypes" which is included above as well as in the lib/mauve.pm
-
-           perl -MText::Wrap -le'local $/; $_= <>; while ( m!SV_REFTYPE_RETURN\("(\w+)"\);\s*[/][*]\s*(.*?)\s*[*][/]!gs) {
-               $i=$1; ($t=$2)=~s/\s+/ /g; $o.=wrap("\n\n=item $i\n\n","",$t);} print "=over 4\n$o\n\n=back\n"' sv.c
-
-     *
-     *  If you update this code please use the above to update the pod.
-     *
-     */
-    /* we use this to make it cleaner to return the size and length at the same time,
-     * and we use two aliases so we can use the above perl snippet to turn it into documentation
-     * the ("" s "") trick guarantees we getting a string passed in (see perl.h for similar stuff)
-     */
-#define SV_REFTYPE_RETURN(s) STMT_START { *ret_len= sizeof(s)-1; return ("" s ""); } STMT_END
-#define SV_BLESSED_RETURN(s) SV_REFTYPE_RETURN(s)
-
     if (ob && SvOBJECT(sv)) {
        char * const name = HvNAME_get(SvSTASH(sv));
-       if (name) {
-           *ret_len = HvNAMELEN_get(SvSTASH(sv));
-           return name;
-       } else SV_BLESSED_RETURN("__ANON__"); /* I don't see when this could happen - demerphq */
+       return name ? name : (char *) "__ANON__";
     }
     else {
        switch (SvTYPE(sv)) {
@@ -8729,59 +8640,29 @@ Perl_sv_reftype_len(pTHX_ const SV *const sv, const int ob, STRLEN *const ret_le
        case SVt_PVNV:
        case SVt_PVMG:
                                if (SvVOK(sv))
-                                   SV_REFTYPE_RETURN("VSTRING"); /* Has special v-string magic */
+                                   return "VSTRING";
                                if (SvROK(sv))
-                                   SV_REFTYPE_RETURN("REF");     /* Is a reference to another ref (C<< $$ref >>) */
-                               else
-                                   SV_REFTYPE_RETURN("SCALAR");  /* Is a reference to a scalar (C<< $$scalar >>) */
-
-       case SVt_PVLV:          if  (SvROK(sv))
-                                   SV_REFTYPE_RETURN("REF");
-                               else if (LvTYPE(sv) == 't' || LvTYPE(sv) == 'T')
-                                   /* tied lvalues appear to be scalars for back-compat reasons */
-                                   SV_REFTYPE_RETURN("SCALAR");
-                               else
-                                   SV_REFTYPE_RETURN("LVALUE"); /* An lvalue reference - B<NOTE>, tied lvalues
-                                                                   appear to be of type C<SCALAR> for backwards
-                                                                   compatibility reasons */
-
-       case SVt_PVAV:          SV_REFTYPE_RETURN("ARRAY"); /* An array reference (C<< @$array >>) */
-       case SVt_PVHV:          SV_REFTYPE_RETURN("HASH");  /* A hash reference (C<< %$hash >>) */
-       case SVt_PVCV:          SV_REFTYPE_RETURN("CODE");  /* A subroutine reference (C<< $code->() >>) */
-       case SVt_PVGV:          if(isGV_with_GP(sv))
-                                   SV_REFTYPE_RETURN("GLOB"); /* A reference to a glob (C<< *$glob >>) */
+                                   return "REF";
                                else
-                                   SV_REFTYPE_RETURN("SCALAR");
-       case SVt_PVFM:          SV_REFTYPE_RETURN("FORMAT"); /* A format reference (C<< *IO{FORMAT} >>) */
-       case SVt_PVIO:          SV_REFTYPE_RETURN("IO");     /* An IO reference (C<< *STDOUT{IO} >>) */
-       case SVt_BIND:          SV_REFTYPE_RETURN("BIND");   /* A bind reference */
-       case SVt_REGEXP:        SV_REFTYPE_RETURN("REGEXP"); /* An executable regular expression (C<< qr/../ >>) */
-       default:                SV_REFTYPE_RETURN("UNKNOWN"); /* This should never be seen */
+                                   return "SCALAR";
+
+       case SVt_PVLV:          return (char *)  (SvROK(sv) ? "REF"
+                               /* tied lvalues should appear to be
+                                * scalars for backwards compatitbility */
+                               : (LvTYPE(sv) == 't' || LvTYPE(sv) == 'T')
+                                   ? "SCALAR" : "LVALUE");
+       case SVt_PVAV:          return "ARRAY";
+       case SVt_PVHV:          return "HASH";
+       case SVt_PVCV:          return "CODE";
+       case SVt_PVGV:          return (char *) (isGV_with_GP(sv)
+                                   ? "GLOB" : "SCALAR");
+       case SVt_PVFM:          return "FORMAT";
+       case SVt_PVIO:          return "IO";
+       case SVt_BIND:          return "BIND";
+       case SVt_REGEXP:        return "REGEXP";
+       default:                return "UNKNOWN";
        }
     }
-#undef SV_BLESSED_RETURN
-#undef SV_REFTYPE_RETURN
-
-}
-
-/*
-=for apidoc sv_reftype
-
-Returns a string describing what type of item the SV is a reference to.
-
-If 'ob' is true and the item is an "object" returns the class name
-instead of the underlying type. Note in this form this routine is not
-recommended as you have no way to know the correct length of the class,
-and null is legal in a class name. Use Perl_sv_reftype_len instead.
-
-=cut
-*/
-
-const char *
-Perl_sv_reftype(pTHX_ const SV *const sv, const int ob){
-    STRLEN len;
-    PERL_ARGS_ASSERT_SV_REFTYPE;
-    return sv_reftype_len(sv,ob,&len);
 }
 
 /*
index 6df104e..fe53969 100644 (file)
@@ -1029,111 +1029,6 @@ XS(XS_Internals_HvREHASH)       /* Subject to change  */
     Perl_croak(aTHX_ "Internals::HvREHASH $hashref");
 }
 
-XS(XS_mauve_reftype)
-{
-    SV *sv;
-    dVAR;
-    dXSARGS;
-    PERL_UNUSED_VAR(cv);
-
-    if (items != 1)
-       croak_xs_usage(cv, "sv");
-
-    SP -= items;
-    sv = (SV*)ST(0);
-
-    if (SvMAGICAL(sv))
-       mg_get(sv);
-    if (!SvROK(sv)) {
-       XSRETURN_NO;
-    } else {
-       STRLEN len;
-       char *type= (char *)sv_reftype_len(SvRV(sv),FALSE,&len);
-        XPUSHs(sv_2mortal(newSVpv(type,len)));
-    }
-}
-
-XS(XS_mauve_refaddr)
-{
-    SV *sv;
-    dVAR;
-    dXSARGS;
-    PERL_UNUSED_VAR(cv);
-
-    if (items != 1)
-       croak_xs_usage(cv, "sv");
-
-    SP -= items;
-    sv = (SV*)ST(0);
-
-    if (SvMAGICAL(sv))
-       mg_get(sv);
-    if (!SvROK(sv)) {
-       XSRETURN_NO;
-    } else {
-       XPUSHs(sv_2mortal(newSVuv(PTR2UV(SvRV(sv)))));
-    }
-}
-
-XS(XS_mauve_blessed)
-{
-    SV *sv;
-    dVAR;
-    dXSARGS;
-    PERL_UNUSED_VAR(cv);
-
-    if (items != 1)
-       croak_xs_usage(cv, "sv");
-
-    SP -= items;
-    sv = (SV*)ST(0);
-
-    if (SvMAGICAL(sv))
-       mg_get(sv);
-    if ( SvROK(sv) && SvOBJECT(SvRV(sv)) ) {
-       STRLEN len;
-       char *type= (char *)sv_reftype_len(SvRV(sv),TRUE,&len);
-        XPUSHs(sv_2mortal(newSVpv(type,len)));
-    } else {
-        XPUSHs(sv_2mortal(newSVpv("",0)));
-    }
-}
-
-XS(XS_mauve_weaken)
-{
-    SV *sv;
-    dVAR;
-    dXSARGS;
-    PERL_UNUSED_VAR(cv);
-
-    if (items != 1)
-       croak_xs_usage(cv, "sv");
-
-    SP -= items;
-    sv = (SV*)ST(0);
-
-    if (SvMAGICAL(sv))
-       mg_get(sv);
-    sv_rvweaken(sv);
-    XSRETURN_EMPTY;
-}
-
-XS(XS_mauve_isweak)
-{
-    dVAR;
-    dXSARGS;
-    if (items != 1)
-       croak_xs_usage(cv,  "sv");
-    {
-       SV *    sv = ST(0);
-       if (SvMAGICAL(sv))
-           mg_get(sv);
-       ST(0) = boolSV(SvROK(sv) && SvWEAKREF(sv));
-       XSRETURN(1);
-    }
-    XSRETURN(1);
-}
-
 XS(XS_re_is_regexp)
 {
     dVAR; 
@@ -1650,11 +1545,6 @@ struct xsub_details details[] = {
     {"Tie::Hash::NamedCapture::NEXTKEY", XS_Tie_Hash_NamedCapture_NEXTK, NULL},
     {"Tie::Hash::NamedCapture::SCALAR", XS_Tie_Hash_NamedCapture_SCALAR, NULL},
     {"Tie::Hash::NamedCapture::flags", XS_Tie_Hash_NamedCapture_flags, NULL}
-    ,{"mauve::reftype", XS_mauve_reftype, "$"}
-    ,{"mauve::refaddr", XS_mauve_refaddr, "$"}
-    ,{"mauve::blessed", XS_mauve_blessed, "$"}
-    ,{"mauve::weaken", XS_mauve_weaken, "$"}
-    ,{"mauve::isweak", XS_mauve_isweak, "$"}
 };
 
 void