ext/Data/Dumper/t/dumper.t See if Data::Dumper works
ext/Data/Dumper/t/overload.t See if Data::Dumper works for overloaded data
ext/Data/Dumper/Todo Data pretty printer, futures
-ext/Data/Util/Changes Data/Hash::Util, Change log
-ext/Data/Util/Makefile.PL Data/Hash::Util, Makefile.PL
-ext/Data/Util/Util.xs Data/Hash::Util, Data::Util XS code
-ext/Data/Util/lib/Data/Util.pm Data/Hash::Util, Data::Util
-ext/Data/Util/lib/Hash/Util.pm Data/Hash::Util, Hash::Util
-ext/Data/Util/t/Data.t Data/Hash::Util, Data::Util test
-ext/Data/Util/t/Hash.t Data/Hash::Util, Hash::Util test
ext/DB_File/Changes Berkeley DB extension change log
ext/DB_File/dbinfo Berkeley DB database version checker
ext/DB_File/DB_File.pm Berkeley DB extension Perl module
lib/getopts.pl Perl library supporting option parsing
lib/h2ph.t See if h2ph works like it should
lib/h2xs.t See if h2xs produces expected lists of files
+lib/Hash/Util.pm Hash::Util
+lib/Hash/Util.t See if Hash::Util works
lib/hostname.pl Old hostname code
lib/I18N/Collate.pm Routines to do strxfrm-based collation
lib/I18N/Collate.t See if I18N::Collate works
lib/importenv.pl Perl routine to get environment into variables
lib/integer.pm For "use integer"
lib/integer.t For "use integer" testing
+lib/Internals.t For Internals::* testing
lib/IPC/Open2.pm Open a two-ended pipe
lib/IPC/Open2.t See if IPC::Open2 works
lib/IPC/Open3.pm Open a three-ended pipe!
Porting/config.sh Sample config.sh
Porting/config_H Sample config.h
Porting/Contract Social contract for contributed modules in Perl core
-Porting/findvars Find occurrences of words
Porting/findrfuncs Find reentrant variants of functions used in an executable
+Porting/findvars Find occurrences of words
Porting/fixCORE Find and fix modules that generate warnings
Porting/fixvars Find undeclared variables with C compiler and fix em
Porting/genlog Generate formatted changelogs by querying p4d
$got = "@got";
-my $expected = "attributes Carp Carp::Heavy DB Exporter Exporter::Heavy main utf8 warnings";
+my $expected = "attributes Carp Carp::Heavy DB Exporter Exporter::Heavy Internals main utf8 warnings";
{
no strict 'vars';
+++ /dev/null
-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
+++ /dev/null
-# 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;
- }
-}
+++ /dev/null
-#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;
-}
-
+++ /dev/null
-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
-
+++ /dev/null
-#!/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} );
require 5.007003;
use strict;
-use Data::Util qw(sv_readonly_flag);
use Carp;
require Exporter;
foreach my $k (@keys) {
$hash->{$k} = undef unless exists $hash->{$k};
}
- sv_readonly_flag %$hash, 1;
+ Internals::SvREADONLY %$hash, 1;
foreach my $k (@keys) {
delete $hash->{$k} unless $original_keys{$k};
}
}
else {
- sv_readonly_flag %$hash, 1;
+ Internals::SvREADONLY %$hash, 1;
}
return undef;
sub unlock_keys (\%) {
my($hash) = shift;
- sv_readonly_flag %$hash, 0;
+ Internals::SvREADONLY %$hash, 0;
return undef;
}
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;
+ unless Internals::SvREADONLY %$hash;
+ Internals::SvREADONLY $hash->{$key}, 1;
}
sub unlock_value (\%$) {
my($hash, $key) = @_;
- sv_readonly_flag $hash->{$key}, 0;
+ Internals::SvREADONLY $hash->{$key}, 0;
}
}
}
use Test::More tests => 45;
-use Data::Util qw(sv_readonly_flag);
my @Exported_Funcs;
BEGIN {
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}) );
+ ok( Internals::SvREADONLY(%hash) );
+ ok( Internals::SvREADONLY($hash{foo}) );
+ ok( Internals::SvREADONLY($hash{bar}) );
unlock_hash ( %hash );
- ok( !sv_readonly_flag(%hash) );
- ok( !sv_readonly_flag($hash{foo}) );
- ok( !sv_readonly_flag($hash{bar}) );
+ ok( !Internals::SvREADONLY(%hash) );
+ ok( !Internals::SvREADONLY($hash{foo}) );
+ ok( !Internals::SvREADONLY($hash{bar}) );
}
--- /dev/null
+#!/usr/bin/perl -Tw
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ @INC = '../lib';
+ chdir 't';
+ }
+}
+
+use Test::More tests => 29;
+
+my $foo;
+
+ok( !Internals::SvREADONLY $foo );
+ok( Internals::SvREADONLY $foo, 1 );
+ok( Internals::SvREADONLY $foo );
+ok( !Internals::SvREADONLY $foo, 0 );
+ok( !Internals::SvREADONLY $foo );
+
+ok( !Internals::SvREADONLY @foo );
+ok( Internals::SvREADONLY @foo, 1 );
+ok( Internals::SvREADONLY @foo );
+ok( !Internals::SvREADONLY @foo, 0 );
+ok( !Internals::SvREADONLY @foo );
+
+ok( !Internals::SvREADONLY $foo[2] );
+ok( Internals::SvREADONLY $foo[2], 1 );
+ok( Internals::SvREADONLY $foo[2] );
+ok( !Internals::SvREADONLY $foo[2], 0 );
+ok( !Internals::SvREADONLY $foo[2] );
+
+ok( !Internals::SvREADONLY %foo );
+ok( Internals::SvREADONLY %foo, 1 );
+ok( Internals::SvREADONLY %foo );
+ok( !Internals::SvREADONLY %foo, 0 );
+ok( !Internals::SvREADONLY %foo );
+
+ok( !Internals::SvREADONLY $foo{foo} );
+ok( Internals::SvREADONLY $foo{foo}, 1 );
+ok( Internals::SvREADONLY $foo{foo} );
+ok( !Internals::SvREADONLY $foo{foo}, 0 );
+ok( !Internals::SvREADONLY $foo{foo} );
+
+is( Internals::SvREFCNT($foo), 1 );
+{
+ my $bar = \$foo;
+ is( Internals::SvREFCNT($foo), 2 );
+ is( Internals::SvREFCNT($bar), 1 );
+}
+is( Internals::SvREFCNT($foo), 1 );
+
XS(XS_utf8_downgrade);
XS(XS_utf8_unicode_to_native);
XS(XS_utf8_native_to_unicode);
+XS(XS_Internals_SvREADONLY);
+XS(XS_Internals_SvREFCNT);
void
Perl_boot_core_UNIVERSAL(pTHX)
newXS("utf8::downgrade", XS_utf8_downgrade, file);
newXS("utf8::native_to_unicode", XS_utf8_native_to_unicode, file);
newXS("utf8::unicode_to_native", XS_utf8_unicode_to_native, file);
+ newXSproto("Internals::SvREADONLY",XS_Internals_SvREADONLY, file, "\\[$%@];$");
+ newXSproto("Internals::SvREFCNT",XS_Internals_SvREFCNT, file, "\\[$%@];$");
}
XSRETURN(1);
}
+XS(XS_Internals_SvREADONLY)
+{
+ dXSARGS;
+ SV *sv = SvRV(ST(0));
+ if (items == 1) {
+ if (SvREADONLY(sv))
+ XSRETURN_YES;
+ else
+ XSRETURN_NO;
+ }
+ else if (items == 2) {
+ if (SvTRUE(ST(1))) {
+ SvREADONLY_on(sv);
+ XSRETURN_YES;
+ }
+ else {
+ SvREADONLY_off(sv);
+ XSRETURN_NO;
+ }
+ }
+ XSRETURN_UNDEF;
+}
+
+XS(XS_Internals_SvREFCNT)
+{
+ dXSARGS;
+ SV *sv = SvRV(ST(0));
+ if (items == 1)
+ XSRETURN_IV(SvREFCNT(sv) - 1); /* minus the SvRV above */
+ else if (items == 2) {
+ SvREFCNT(sv) = SvIV(ST(1));
+ XSRETURN_IV(SvREFCNT(sv));
+ }
+ XSRETURN_UNDEF;
+}
+
projects / platform / upstream / perl.git / commitdiff