Move the readonly interface back to universal.c,

(new name: Internals::SvREADONLY), remove Data::Util,
move Hash::Util to lib, also introduce refcnt interface
(Internals::SvREFCNT).	Make both the new interfaces
to be more sane so that if they set the value, they return
the new value, not the old one.

p4raw-id: //depot/perl@15201

7 files changed, 0 insertions, 586 deletions

diff --git a/ext/Data/Util/Changes b/ext/Data/Util/Changes
deleted file mode 100644
index f877d08678..0000000000
--- a/ext/Data/Util/Changes
+++ /dev/null
@@ -1,27 +0,0 @@
-0.04  Sun Mar 10 13:37:08 EST 2002
-  * Bugs in the restricted hash implementation have been fixed.  All
-    tests should pass on a perl sometime after about 15160
-  * Minimum version is now 5.7.3
-  - Changed diagnostic expecations to match new restricted hash 
-    diagnostics.
-
-0.03  Sat Mar  9 20:11:00 EST 2002
-  *** NOTE *** There are known failures in t/Hash.t.  These are
-  due to bugs in perl's restricted hash implementation.  They have
-  been left failing so Those That Know How To Fix It know where
-  the bugs are.
-
-  * Data::Util::readonly() is now sv_readonly_flag() to make its
-    function less ambiguous.
-  * Hash::Util::lock_key/unlock_key is now lock_value/unlock_value
-    to make its functionality less ambiguous.  It also takes
-    somewhat different arguments.
-  * Added lock_hash(), unlock_hash().
-
-0.02  Wed Feb 27 23:35:58 EST 2002
-  * lock_keys(%hash, @keys) implemented
-  * tarball name changed to the somewhat more proper Data-Hash-Utils
-
-0.01  Tue Feb 26 23:18:03 EST 2002
-  - First released version
-  - There are some failures at the end of Hash.t
diff --git a/ext/Data/Util/Makefile.PL b/ext/Data/Util/Makefile.PL
deleted file mode 100644
index ef6bc3c3ab..0000000000
--- a/ext/Data/Util/Makefile.PL
+++ /dev/null
@@ -1,53 +0,0 @@
-# A template for Makefile.PL.
-# - Set the $PACKAGE variable to the name of your module.
-# - Set $LAST_API_CHANGE to reflect the last version you changed the API 
-#   of your module.
-# - Fill in your dependencies in PREREQ_PM
-# Alternatively, you can say the hell with this and use h2xs.
-
-require 5.007003;
-
-use ExtUtils::MakeMaker;
-
-$PACKAGE = 'Data::Util';
-($PACKAGE_FILE = $PACKAGE) =~ s|::|/|g;
-$LAST_API_CHANGE = 0.03;
-
-eval "require $PACKAGE";
-
-unless ($@) { # Make sure we did find the module.
-    print <<"CHANGE_WARN" if ${$PACKAGE.'::VERSION'} < $LAST_API_CHANGE;
-
-NOTE: There have been API changes between this version and any older
-than version $LAST_API_CHANGE!  Please read the Changes file if you
-are upgrading from a version older than $LAST_API_CHANGE.
-
-CHANGE_WARN
-}
-
-WriteMakefile(
-    NAME            => $PACKAGE,
-    DISTNAME        => 'Data-Hash-Utils',
-    VERSION_FROM    => "lib/$PACKAGE_FILE.pm", # finds $VERSION
-    PREREQ_PM       => {   },
-);
-
-
-{
-    package MY;
-
-    sub test_via_harness {
-        my($self, $orig_perl, $tests) = @_;
-
-        my @perls = ($orig_perl);
-        push @perls, qw(bleadperl)
-          if $ENV{PERL_TEST_ALL};
-
-        my $out;
-        foreach my $perl (@perls) {
-            $out .= $self->SUPER::test_via_harness($perl, $tests);
-        }
-
-        return $out;
-    }
-}
diff --git a/ext/Data/Util/Util.xs b/ext/Data/Util/Util.xs
deleted file mode 100644
index 6d246ddf51..0000000000
--- a/ext/Data/Util/Util.xs
+++ /dev/null
@@ -1,29 +0,0 @@
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-
-
-MODULE=Data::Util   PACKAGE=Data::Util
-
-int
-sv_readonly_flag(...)
-PROTOTYPE: \[$%@];$
-CODE:
-{
-    SV *sv = SvRV(ST(0));
-    IV old = SvREADONLY(sv);
-
-    if (items == 2) {
-        if (SvTRUE(ST(1))) {
-            SvREADONLY_on(sv);
-        }
-        else {
-            SvREADONLY_off(sv);
-        }
-    }
-    if (old)
-        XSRETURN_YES;
-    else
-        XSRETURN_NO;
-}
-
diff --git a/ext/Data/Util/lib/Data/Util.pm b/ext/Data/Util/lib/Data/Util.pm
deleted file mode 100644
index 26e2993a9b..0000000000
--- a/ext/Data/Util/lib/Data/Util.pm
+++ /dev/null
@@ -1,73 +0,0 @@
-package Data::Util;
-
-require Exporter;
-require DynaLoader;
-
-our @ISA        = qw(Exporter DynaLoader);
-our @EXPORT_OK  = qw(sv_readonly_flag);
-our $VERSION    = 0.04;
-
-bootstrap Data::Util $VERSION;
-
-1;
-
-__END__
-
-=head1 NAME
-
-Data::Util - A selection of general-utility data subroutines
-
-=head1 SYNOPSIS
-
-  use Data::Util qw(sv_readonly_flag);
-
-  my $sv_readonly = sv_readonly_flag(%some_data);
-
-  sv_readonly_flag(@some_data, 1);  # Set the sv_readonly flag on
-                                    # @some_data to true.
-
-=head1 DESCRIPTION
-
-C<Data::Util> contains a selection of subroutines which are useful on
-scalars, hashes and lists (and thus wouldn't fit into Scalar, Hash or
-List::Util).  All of the routines herein will work equally well on a
-scalar, hash, list or even hash & list elements.
-
-    sv_readonly_flag($some_data);
-    sv_readonly_flag(@some_data);
-    sv_readonly_flag(%some_data);
-    sv_readonly_flag($some_data{key});
-    sv_readonly_flag($some_data[3]);
-
-We'll just refer to the conglomeration as "DATA".
-
-By default C<Data::Util> does not export any subroutines.  You can ask
-for...
-
-=over 4
-
-=item sv_readonly_flag
-
-  my $sv_readonly = sv_readonly_flag(DATA);
-  sv_readonly_flag(DATA, 1);    # set sv_readonly true
-  sv_readonly_flag(DATA, 0);    # set sv_readonly false
-
-This gets/sets the sv_readonly flag on the given DATA.  When setting
-it returns the previous state of the flag.  This is intended for
-people I<that know what they're doing.>
-
-The exact behavior exhibited by a piece of DATA when sv_readonly is
-set depends on what type of data it is.  B<It doesn't even necessarily
-make the data readonly!>  Look for specific functions in Scalar::Util,
-List::Util and Hash::Util for making those respective types readonly.
-
-=head1 AUTHOR
-
-Michael G Schwern <schwern@pobox.com> using XS code by Nick Ing-Simmons.
-
-=head1 SEE ALSO
-
-L<Scalar::Util>, L<List::Util>, L<Hash::Util>
-
-=cut
-
diff --git a/ext/Data/Util/lib/Hash/Util.pm b/ext/Data/Util/lib/Hash/Util.pm
deleted file mode 100644
index c54fbdc0d1..0000000000
--- a/ext/Data/Util/lib/Hash/Util.pm
+++ /dev/null
@@ -1,191 +0,0 @@
-package Hash::Util;
-
-require 5.007003;
-use strict;
-use Data::Util qw(sv_readonly_flag);
-use Carp;
-
-require Exporter;
-our @ISA        = qw(Exporter);
-our @EXPORT_OK  = qw(lock_keys unlock_keys lock_value unlock_value
-                     lock_hash unlock_hash
-                    );
-our $VERSION    = 0.04;
-
-
-=head1 NAME
-
-Hash::Util - A selection of general-utility hash subroutines
-
-=head1 SYNOPSIS
-
-  use Hash::Util qw(lock_keys   unlock_keys 
-                    lock_value  unlock_value
-                    lock_hash   unlock_hash
-                   );
-
-  %hash = (foo => 42, bar => 23);
-  lock_keys(%hash);
-  lock_keys(%hash, @keyset);
-  unlock_keys(%hash);
-
-  lock_value  (%hash, 'foo');
-  unlock_value(%hash, 'foo');
-
-  lock_hash  (%hash);
-  unlock_hash(%hash);
-
-
-=head1 DESCRIPTION
-
-C<Hash::Util> contains special functions for manipulating hashes that
-don't really warrant a keyword.
-
-By default C<Hash::Util> does not export anything.
-
-=head2 Restricted hashes
-
-5.8.0 introduces the ability to restrict a hash to a certain set of
-keys.  No keys outside of this set can be added.  It also introduces
-the ability to lock an individual key so it cannot be deleted and the
-value cannot be changed.
-
-This is intended to largely replace the deprecated pseudo-hashes.
-
-=over 4
-
-=item lock_keys
-
-=item unlock_keys
-
-  lock_keys(%hash);
-  lock_keys(%hash, @keys);
-
-  unlock_keys(%hash;)
-
-Restricts the given %hash's set of keys to @keys.  If @keys is not
-given it restricts it to its current keyset.  No more keys can be
-added.  delete() and exists() will still work, but it does not effect
-the set of allowed keys.
-
-Removes the restriction on the %hash's keyset.
-
-=cut
-
-sub lock_keys (\%;@) {
-    my($hash, @keys) = @_;
-
-    if( @keys ) {
-        my %keys = map { ($_ => 1) } @keys;
-        my %original_keys = map { ($_ => 1) } keys %$hash;
-        foreach my $k (keys %original_keys) {
-            die sprintf "Hash has key '$k' which is not in the new key ".
-                        "set at %s line %d\n", (caller)[1,2]
-              unless $keys{$k};
-        }
-    
-        foreach my $k (@keys) {
-            $hash->{$k} = undef unless exists $hash->{$k};
-        }
-        sv_readonly_flag %$hash, 1;
-
-        foreach my $k (@keys) {
-            delete $hash->{$k} unless $original_keys{$k};
-        }
-    }
-    else {
-        sv_readonly_flag %$hash, 1;
-    }
-
-    return undef;
-}
-
-sub unlock_keys (\%) {
-    my($hash) = shift;
-
-    sv_readonly_flag %$hash, 0;
-    return undef;
-}
-
-=item lock_value
-
-=item unlock_value
-
-  lock_key  (%hash, $key);
-  unlock_key(%hash, $key);
-
-Locks and unlocks an individual key of a hash.  The value of a locked
-key cannot be changed.
-
-%hash must have already been locked for this to have useful effect.
-
-=cut
-
-sub lock_value (\%$) {
-    my($hash, $key) = @_;
-    carp "Cannot usefully lock values in an unlocked hash" 
-      unless sv_readonly_flag %$hash;
-    sv_readonly_flag $hash->{$key}, 1;
-}
-
-sub unlock_value (\%$) {
-    my($hash, $key) = @_;
-    sv_readonly_flag $hash->{$key}, 0;
-}
-
-
-=item B<lock_hash>
-
-=item B<unlock_hash>
-
-    lock_hash(%hash);
-    unlock_hash(%hash);
-
-lock_hash() locks an entire hash, making all keys and values readonly.
-No value can be changed, no keys can be added or deleted.
-
-unlock_hash() does the opposite.  All keys and values are made
-read/write.  All values can be changed and keys can be added and
-deleted.
-
-=cut
-
-sub lock_hash (\%) {
-    my($hash) = shift;
-
-    lock_keys(%$hash);
-
-    foreach my $key (keys %$hash) {
-        lock_value(%$hash, $key);
-    }
-
-    return 1;
-}
-
-sub unlock_hash (\%) {
-    my($hash) = shift;
-
-    foreach my $key (keys %$hash) {
-        unlock_value(%$hash, $key);
-    }
-
-    unlock_keys(%$hash);
-
-    return 1;
-}
-
-
-=back
-
-=head1 AUTHOR
-
-Michael G Schwern <schwern@pobox.com> on top of code by Nick
-Ing-Simmons and Jeffrey Friedl.
-
-=head1 SEE ALSO
-
-L<Scalar::Util>, L<List::Util>, L<Hash::Util>
-
-=cut
-
-1;
diff --git a/ext/Data/Util/t/Data.t b/ext/Data/Util/t/Data.t
deleted file mode 100644
index 6198c3a9f3..0000000000
--- a/ext/Data/Util/t/Data.t
+++ /dev/null
@@ -1,42 +0,0 @@
-#!/usr/bin/perl -Tw
-
-BEGIN {
-    if( $ENV{PERL_CORE} ) {
-        @INC = '../lib';
-        chdir 't';
-    }
-}
-use Test::More tests => 26;
-
-use Data::Util;
-BEGIN { use_ok 'Data::Util', qw(sv_readonly_flag); }
-
-ok( !sv_readonly_flag $foo );
-ok( !sv_readonly_flag $foo, 1 );
-ok( sv_readonly_flag $foo );
-ok( sv_readonly_flag $foo, 0 );
-ok( !sv_readonly_flag $foo );
-
-ok( !sv_readonly_flag @foo );
-ok( !sv_readonly_flag @foo, 1 );
-ok( sv_readonly_flag @foo );
-ok( sv_readonly_flag @foo, 0 );
-ok( !sv_readonly_flag @foo );
-
-ok( !sv_readonly_flag $foo[2] );
-ok( !sv_readonly_flag $foo[2], 1 );
-ok( sv_readonly_flag $foo[2] );
-ok( sv_readonly_flag $foo[2], 0 );
-ok( !sv_readonly_flag $foo[2] );
-
-ok( !sv_readonly_flag %foo );
-ok( !sv_readonly_flag %foo, 1 );
-ok( sv_readonly_flag %foo );
-ok( sv_readonly_flag %foo, 0 );
-ok( !sv_readonly_flag %foo );
-
-ok( !sv_readonly_flag $foo{foo} );
-ok( !sv_readonly_flag $foo{foo}, 1 );
-ok( sv_readonly_flag $foo{foo} );
-ok( sv_readonly_flag $foo{foo}, 0 );
-ok( !sv_readonly_flag $foo{foo} );
diff --git a/ext/Data/Util/t/Hash.t b/ext/Data/Util/t/Hash.t
deleted file mode 100644
index b1f9e79304..0000000000
--- a/ext/Data/Util/t/Hash.t
+++ /dev/null
@@ -1,171 +0,0 @@
-#!/usr/bin/perl -Tw
-
-BEGIN {
-    if( $ENV{PERL_CORE} ) {
-        @INC = '../lib';
-        chdir 't';
-    }
-}
-use Test::More tests => 45;
-use Data::Util qw(sv_readonly_flag);
-
-my @Exported_Funcs;
-BEGIN { 
-    @Exported_Funcs = qw(lock_keys   unlock_keys
-                         lock_value  unlock_value
-                         lock_hash   unlock_hash
-                        );
-    use_ok 'Hash::Util', @Exported_Funcs;
-}
-foreach my $func (@Exported_Funcs) {
-    can_ok __PACKAGE__, $func;
-}
-
-my %hash = (foo => 42, bar => 23, locked => 'yep');
-lock_keys(%hash);
-eval { $hash{baz} = 99; };
-like( $@, qr/^Attempt to access disallowed key 'baz' in a fixed hash/,
-                                                       'lock_keys()');
-is( $hash{bar}, 23 );
-ok( !exists $hash{baz} );
-
-delete $hash{bar};
-ok( !exists $hash{bar} );
-$hash{bar} = 69;
-is( $hash{bar}, 69 );
-
-eval { () = $hash{i_dont_exist} };
-like( $@, qr/^Attempt to access disallowed key 'i_dont_exist' in a fixed hash/ );
-
-lock_value(%hash, 'locked');
-eval { print "# oops" if $hash{four} };
-like( $@, qr/^Attempt to access disallowed key 'four' in a fixed hash/ );
-
-eval { $hash{"\x{2323}"} = 3 };
-like( $@, qr/^Attempt to access disallowed key '(.*)' in a fixed hash/,
-                                               'wide hex key' );
-
-eval { delete $hash{locked} };
-like( $@, qr/^Attempt to delete readonly key 'locked' from a fixed hash/,
-                                           'trying to delete a locked key' );
-eval { $hash{locked} = 42; };
-like( $@, qr/^Modification of a read-only value attempted/,
-                                           'trying to change a locked key' );
-is( $hash{locked}, 'yep' );
-
-eval { delete $hash{I_dont_exist} };
-like( $@, qr/^Attempt to delete disallowed key 'I_dont_exist' from a fixed hash/,
-                             'trying to delete a key that doesnt exist' );
-
-ok( !exists $hash{I_dont_exist} );
-
-unlock_keys(%hash);
-$hash{I_dont_exist} = 42;
-is( $hash{I_dont_exist}, 42,    'unlock_keys' );
-
-eval { $hash{locked} = 42; };
-like( $@, qr/^Modification of a read-only value attempted/,
-                             '  individual key still readonly' );
-eval { delete $hash{locked} },
-is( $@, '', '  but can be deleted :(' );
-
-unlock_value(%hash, 'locked');
-$hash{locked} = 42;
-is( $hash{locked}, 42,  'unlock_value' );
-
-
-TODO: {
-#    local $TODO = 'assigning to a hash screws with locked keys';
-
-    my %hash = ( foo => 42, locked => 23 );
-
-    lock_keys(%hash);
-    lock_value(%hash, 'locked');
-    eval { %hash = ( wubble => 42 ) };  # we know this will bomb
-    like( $@, qr/^Attempt to clear a fixed hash/ );
-
-    eval { unlock_value(%hash, 'locked') }; # but this shouldn't
-    is( $@, '', 'unlock_value() after denied assignment' );
-
-    is_deeply( \%hash, { foo => 42, locked => 23 },
-                      'hash should not be altered by denied assignment' );
-    unlock_keys(%hash);
-}
-
-{ 
-    my %hash = (KEY => 'val', RO => 'val');
-    lock_keys(%hash);
-    lock_value(%hash, 'RO');
-
-    eval { %hash = (KEY => 1) };
-    like( $@, qr/^Attempt to clear a fixed hash/ );
-}
-
-# TODO:  This should be allowed but it might require putting extra
-#        code into aassign.
-{
-    my %hash = (KEY => 1, RO => 2);
-    lock_keys(%hash);
-    eval { %hash = (KEY => 1, RO => 2) };
-    like( $@, qr/^Attempt to clear a fixed hash/ );
-}
-
-
-
-{
-    my %hash = ();
-    lock_keys(%hash, qw(foo bar));
-    is( keys %hash, 0,  'lock_keys() w/keyset shouldnt add new keys' );
-    $hash{foo} = 42;
-    is( keys %hash, 1 );
-    eval { $hash{wibble} = 42 };
-    like( $@, qr/^Attempt to access disallowed key 'wibble' in a fixed hash/,
-                        '  locked');
-
-    unlock_keys(%hash);
-    eval { $hash{wibble} = 23; };
-    is( $@, '', 'unlock_keys' );
-}
-
-
-{
-    my %hash = (foo => 42, bar => undef, baz => 0);
-    lock_keys(%hash, qw(foo bar baz up down));
-    is( keys %hash, 3,   'lock_keys() w/keyset didnt add new keys' );
-    is_deeply( \%hash, { foo => 42, bar => undef, baz => 0 } );
-
-    eval { $hash{up} = 42; };
-    is( $@, '' );
-
-    eval { $hash{wibble} = 23 };
-    like( $@, qr/^Attempt to access disallowed key 'wibble' in a fixed hash/, '  locked' );
-}
-
-
-{
-    my %hash = (foo => 42, bar => undef);
-    eval { lock_keys(%hash, qw(foo baz)); };
-    is( $@, sprintf("Hash has key 'bar' which is not in the new key ".
-                    "set at %s line %d\n", __FILE__, __LINE__ - 2) );
-}
-
-
-{
-    my %hash = (foo => 42, bar => 23);
-    lock_hash( %hash );
-
-    ok( sv_readonly_flag(%hash) );
-    ok( sv_readonly_flag($hash{foo}) );
-    ok( sv_readonly_flag($hash{bar}) );
-
-    unlock_hash ( %hash );
-
-    ok( !sv_readonly_flag(%hash) );
-    ok( !sv_readonly_flag($hash{foo}) );
-    ok( !sv_readonly_flag($hash{bar}) );
-}
-
-
-lock_keys(%ENV);
-eval { () = $ENV{I_DONT_EXIST} };
-like( $@, qr/^Attempt to access disallowed key 'I_DONT_EXIST' in a fixed hash/,   'locked %ENV');