1 files changed, 90 insertions, 0 deletions
diff --git a/gnu/usr.bin/perl/cpan/Memoize/t/basic.t b/gnu/usr.bin/perl/cpan/Memoize/t/basic.t
new file mode 100644
index 00000000000..fd4527f539b
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/Memoize/t/basic.t
@@ -0,0 +1,90 @@
+use strict; use warnings;
+use Memoize;
+use Test::More tests => 27;
+
+# here we test memoize() itself i.e. whether it sets everything up as requested
+# (except for the (LIST|SCALAR)_CACHE options which are tested elsewhere)
+
+my ( $sub, $wrapped );
+
+sub dummy {1}
+$sub = \&dummy;
+$wrapped = memoize 'dummy';
+isnt \&dummy, $sub, 'memoizing replaces the sub';
+is ref $wrapped, 'CODE', '... and returns a coderef';
+is \&dummy, $wrapped, '... which is the replacement';
+
+sub dummy_i {1}
+$sub = \&dummy_i;
+$wrapped = memoize 'dummy_i', INSTALL => 'another';
+is \&dummy_i, $sub, 'INSTALL does not replace the sub';
+is \&another, $wrapped, '... but installs the memoized version where requested';
+
+sub dummy_p {1}
+$sub = \&dummy_p;
+$wrapped = memoize 'dummy_p', INSTALL => 'another::package::too';
+is \&another::package::too, $wrapped, '... even if that is a whole other package';
+
+sub find_sub {
+	my ( $needle, $symtbl ) = ( @_, *main::{'HASH'} );
+	while ( my ( $name, $glob ) = each %$symtbl ) {
+		if ( $name =~ /::\z/ ) {
+			find_sub( $needle, *$glob{'HASH'} ) unless *$glob{'HASH'} == $symtbl;
+		} elsif ( defined( my $sub = eval { *$glob{'CODE'} } ) ) {
+			return 1 if $needle == $sub;
+		}
+	}
+	return !1;
+}
+
+sub dummy_u {1}
+$sub = \&dummy_u;
+$wrapped = memoize 'dummy_u', INSTALL => undef;
+is \&dummy_u, $sub, '... unless the passed name is undef';
+ok !find_sub( $wrapped ), '... which does not install the memoized version anywhere';
+
+$sub = sub {1};
+$wrapped = memoize $sub;
+is ref $wrapped, 'CODE', 'memoizing a $coderef wraps it';
+ok !find_sub( $wrapped ), '... without installing the memoized version anywhere';
+
+$sub = sub {1};
+$wrapped = memoize $sub, INSTALL => 'another';
+is \&another, $wrapped, '... unless requested using INSTALL';
+
+my $num_args;
+sub fake_normalize { $num_args = @_ }
+$wrapped = memoize sub {1}, NORMALIZER => 'fake_normalize';
+$wrapped->( ('x') x 7 );
+is $num_args, 7, 'NORMALIZER installs the requested normalizer; both by name';
+$wrapped = memoize sub {1}, NORMALIZER => \&fake_normalize;
+$wrapped->( ('x') x 23 );
+is $num_args, 23, '... as well as by reference';
+
+$wrapped = eval { memoize 'dummy_none' };
+is $wrapped, undef, 'memoizing a non-existent function fails';
+like $@, qr/^Cannot operate on nonexistent function `dummy_none'/, '... with the expected error';
+
+for my $nonsub ({}, [], \my $x) {
+	is eval { memoize $nonsub }, undef, "memoizing ${\ref $nonsub} ref fails";
+	like $@, qr/^Usage: memoize 'functionname'\|coderef \{OPTIONS\}/, '... with the expected error';
+}
+
+sub no_warnings_ok (&$) {
+	my $w;
+	local $SIG{'__WARN__'} = sub { push @$w, @_; &diag };
+	shift->();
+	local $Test::Builder::Level = $Test::Builder::Level + 1;
+	is( $w, undef, shift ) or diag join '', @$w;
+}
+
+sub q1 ($) { $_[0] + 1 }
+sub q2 ()  { time }
+sub q3     { join "--", @_ }
+
+no_warnings_ok { memoize 'q1' } 'no warnings with $ protype';
+no_warnings_ok { memoize 'q2' } 'no warnings with empty protype';
+no_warnings_ok { memoize 'q3' } 'no warnings without protype';
+is q1(@{['a'..'z']}), 27, '$ prototype is honored';
+is eval('q2("test")'), undef, 'empty prototype is honored';
+like $@, qr/^Too many arguments for main::q2 /, '... with the expected error';