From 4074f2d6a9bcfb33f0da7933ac26c5df0d2f21f7 Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Thu, 5 Jul 2012 10:15:42 -0500 Subject: modernize, cleanup, etc --- .gitignore | 17 +++++++++ Changes | 27 +++++++------ bin/cryptogram.pl | 1 + bin/jotto.pl | 1 + bin/mastermind.pl | 1 + bin/solve-ghost.pl | 1 + bin/solve-spook.pl | 1 + bin/solve-superghost.pl | 1 + bin/solve-xghost.pl | 1 + dist.ini | 11 ++---- lib/Games/Word.pm | 28 ++++---------- lib/Games/Word/Wordlist.pm | 84 ++++++----------------------------------- t/000-load.t | 10 ----- t/001-system-wordlist.t | 18 --------- t/002-array-wordlist.t | 13 ------- t/003-system-wordlist-nocache.t | 26 ------------- t/010-random-permutation.t | 15 -------- t/011-is-permutation.t | 18 --------- t/012-shared-letters.t | 38 ------------------- t/013-random-string-from.t | 22 ----------- t/014-substrings.t | 42 --------------------- t/015-subpermutations.t | 34 ----------------- t/020-random-word.t | 26 ------------- t/021-is-word.t | 12 ------ t/022-random-word-nocache.t | 32 ---------------- t/023-is-word-nocache.t | 21 ----------- t/024-anagrams.t | 14 ------- t/025-subwords.t | 14 ------- t/anagrams.t | 16 ++++++++ t/array-wordlist.t | 16 ++++++++ t/is-permutation.t | 21 +++++++++++ t/is-word-nocache.t | 23 +++++++++++ t/is-word.t | 14 +++++++ t/random-permutation.t | 20 ++++++++++ t/random-string-from.t | 28 ++++++++++++++ t/random-word-nocache.t | 34 +++++++++++++++++ t/random-word.t | 29 ++++++++++++++ t/shared-letters.t | 40 ++++++++++++++++++++ t/subpermutations.t | 36 ++++++++++++++++++ t/substrings.t | 43 +++++++++++++++++++++ t/subwords.t | 16 ++++++++ t/system-wordlist-nocache.t | 33 ++++++++++++++++ t/system-wordlist.t | 21 +++++++++++ 43 files changed, 453 insertions(+), 466 deletions(-) create mode 100644 .gitignore delete mode 100644 t/000-load.t delete mode 100644 t/001-system-wordlist.t delete mode 100644 t/002-array-wordlist.t delete mode 100644 t/003-system-wordlist-nocache.t delete mode 100644 t/010-random-permutation.t delete mode 100644 t/011-is-permutation.t delete mode 100644 t/012-shared-letters.t delete mode 100644 t/013-random-string-from.t delete mode 100644 t/014-substrings.t delete mode 100644 t/015-subpermutations.t delete mode 100644 t/020-random-word.t delete mode 100644 t/021-is-word.t delete mode 100644 t/022-random-word-nocache.t delete mode 100644 t/023-is-word-nocache.t delete mode 100644 t/024-anagrams.t delete mode 100644 t/025-subwords.t create mode 100644 t/anagrams.t create mode 100644 t/array-wordlist.t create mode 100644 t/is-permutation.t create mode 100644 t/is-word-nocache.t create mode 100644 t/is-word.t create mode 100644 t/random-permutation.t create mode 100644 t/random-string-from.t create mode 100644 t/random-word-nocache.t create mode 100644 t/random-word.t create mode 100644 t/shared-letters.t create mode 100644 t/subpermutations.t create mode 100644 t/substrings.t create mode 100644 t/subwords.t create mode 100644 t/system-wordlist-nocache.t create mode 100644 t/system-wordlist.t diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..d809b97 --- /dev/null +++ b/.gitignore @@ -0,0 +1,17 @@ +cover_db +META.* +MYMETA.* +Makefile +blib +inc +pm_to_blib +MANIFEST +Makefile.old +nytprof.out +MANIFEST.bak +*.sw[po] +.DS_Store +.build +Games-Word-* +*.bs +*.o diff --git a/Changes b/Changes index c28c38f..b5465a3 100644 --- a/Changes +++ b/Changes @@ -1,14 +1,19 @@ Revision history for Games-Word -0.05 Nov 16, 2009 - A few minor cleanups, convert to Dist::Zilla -0.04 Dec 18, 2008 - Fix is_substring -0.03 Dec 17, 2008 - More test fixups - Add spook solver -0.02 Feb 04, 2008 - Fix up some docs and tests. -0.01 Feb 03, 2008 - First version, released on an unsuspecting world. +{{$NEXT}} +0.05 2009-11-16 + - A few minor cleanups, convert to Dist::Zilla + +0.04 2008-12-18 + - Fix is_substring + +0.03 2008-12-17 + - More test fixups + - Add spook solver + +0.02 2008-02-04 + - Fix up some docs and tests. + +0.01 2008-02-03 + - First version, released on an unsuspecting world. diff --git a/bin/cryptogram.pl b/bin/cryptogram.pl index 7d89e6c..e965af7 100644 --- a/bin/cryptogram.pl +++ b/bin/cryptogram.pl @@ -2,6 +2,7 @@ use strict; use warnings; use Games::Word qw/random_permutation/; +# PODNAME: cryptogram.pl my $alphabet = 'abcdefghijklmnopqrstuvwxyz'; my $key = random_permutation $alphabet; diff --git a/bin/jotto.pl b/bin/jotto.pl index 4d9f509..f26c9b1 100644 --- a/bin/jotto.pl +++ b/bin/jotto.pl @@ -3,6 +3,7 @@ use strict; use warnings; use Games::Word qw/shared_letters/; use Games::Word::Wordlist; +# PODNAME: jotto.pl my $wl = Games::Word::Wordlist->new('/usr/share/dict/words'); $wl->remove_words($wl->words_like(qr/^(.{0,4}|.{6,})$/)); diff --git a/bin/mastermind.pl b/bin/mastermind.pl index 8f8ab34..b3c595e 100644 --- a/bin/mastermind.pl +++ b/bin/mastermind.pl @@ -3,6 +3,7 @@ use strict; use warnings; use Games::Word qw/random_string_from shared_letters shared_letters_by_position/; +# PODNAME: mastermind.pl my $word = random_string_from "abcdefg", 5; while (1) { diff --git a/bin/solve-ghost.pl b/bin/solve-ghost.pl index c65cd91..f969a39 100644 --- a/bin/solve-ghost.pl +++ b/bin/solve-ghost.pl @@ -2,6 +2,7 @@ use strict; use warnings; use Games::Word::Wordlist; +# PODNAME: solve-ghost.pl die "Usage: $0 \n" unless @ARGV; my $wl = Games::Word::Wordlist->new('/usr/share/dict/words'); diff --git a/bin/solve-spook.pl b/bin/solve-spook.pl index f28c8e8..2ef27de 100644 --- a/bin/solve-spook.pl +++ b/bin/solve-spook.pl @@ -2,6 +2,7 @@ use strict; use warnings; use Games::Word::Wordlist; +# PODNAME: solve-spook.pl die "Usage: $0 \n" unless @ARGV; my $wl = Games::Word::Wordlist->new('/usr/share/dict/words'); diff --git a/bin/solve-superghost.pl b/bin/solve-superghost.pl index e5fcbee..d3a1eee 100644 --- a/bin/solve-superghost.pl +++ b/bin/solve-superghost.pl @@ -2,6 +2,7 @@ use strict; use warnings; use Games::Word::Wordlist; +# PODNAME: solve-superghost.pl die "Usage: $0 \n" unless @ARGV; my $wl = Games::Word::Wordlist->new('/usr/share/dict/words'); diff --git a/bin/solve-xghost.pl b/bin/solve-xghost.pl index 7502803..aea1872 100644 --- a/bin/solve-xghost.pl +++ b/bin/solve-xghost.pl @@ -2,6 +2,7 @@ use strict; use warnings; use Games::Word::Wordlist; +# PODNAME: solve-xghost.pl die "Usage: $0 \n" unless @ARGV; my $wl = Games::Word::Wordlist->new('/usr/share/dict/words'); diff --git a/dist.ini b/dist.ini index dc54688..a001a27 100644 --- a/dist.ini +++ b/dist.ini @@ -1,14 +1,11 @@ name = Games-Word -version = 0.05 author = Jesse Luehrs license = Perl_5 copyright_holder = Jesse Luehrs abstract = utility functions for writing word games -[@Classic] +[@DOY] +dist = Games-Word +repository = github -[Prereq] -List::MoreUtils = 0 -Math::Combinatorics = 0 -Test::Deep = 0 -Test::Exception = 0 +[AutoPrereqs] diff --git a/lib/Games/Word.pm b/lib/Games/Word.pm index e1a423f..232112e 100644 --- a/lib/Games/Word.pm +++ b/lib/Games/Word.pm @@ -10,10 +10,7 @@ our @EXPORT_OK = qw/random_permutation is_permutation all_permutations use Math::Combinatorics qw/factorial/; use Test::Deep::NoTest; - -=head1 NAME - -Games::Word - utility functions for writing word games +# ABSTRACT: utility functions for writing word games =head1 SYNOPSIS @@ -28,7 +25,9 @@ Games::Word - utility functions for writing word games =head1 DESCRIPTION -Games::Word provides several utility functions for writing word games, such as manipulating permutations of strings, testing for similarity of strings, and finding strings from a given source of characters. +Games::Word provides several utility functions for writing word games, such as +manipulating permutations of strings, testing for similarity of strings, and +finding strings from a given source of characters. =over 4 @@ -244,14 +243,6 @@ sub all_subpermutations { return map { all_permutations $_ } all_substrings shift; } -=head1 SEE ALSO - -L - -=head1 AUTHOR - -Jesse Luehrs, C<< >> - =head1 BUGS No known bugs. @@ -260,6 +251,10 @@ Please report any bugs through RT: email C, or browse L. +=head1 SEE ALSO + +L + =head1 SUPPORT You can find this documentation for this module with the perldoc command. @@ -288,13 +283,6 @@ L =back -=head1 COPYRIGHT AND LICENSE - -Copyright 2008-2009 Jesse Luehrs. - -This program is free software; you can redistribute it and/or modify it -under the same terms as Perl itself. - =cut 1; diff --git a/lib/Games/Word/Wordlist.pm b/lib/Games/Word/Wordlist.pm index 30d2be4..4a8c113 100644 --- a/lib/Games/Word/Wordlist.pm +++ b/lib/Games/Word/Wordlist.pm @@ -3,10 +3,7 @@ use strict; use warnings; use Games::Word qw/all_permutations all_subpermutations/; use List::MoreUtils qw/uniq/; - -=head1 NAME - -Games::Word::Wordlist - manages a list of words +# ABSTRACT: manages a list of words =head1 SYNOPSIS @@ -25,11 +22,7 @@ randomly or by regex. =cut -=head1 CONSTRUCTOR - -=over 4 - -=item new PARAMHASH +=method new PARAMHASH The constructor initializes the word list with words, either from a file or from an arrayref, given as the first argument. The remaining arguments are a @@ -48,8 +41,6 @@ program. =back -=back - =cut sub new { @@ -86,11 +77,7 @@ sub new { return $self; } -=head1 METHODS - -=over 4 - -=item add_words +=method add_words Add words to the word list. Only works if the word list has been cached. @@ -117,7 +104,7 @@ sub add_words { return; } -=item remove_words LIST +=method remove_words LIST Removes words in LIST from the word list. Only works if the word list is cached. @@ -134,7 +121,7 @@ sub remove_words { return; } -=item words +=method words Returns the number of words in the word list. @@ -186,7 +173,7 @@ sub _random_word_nocache { return $word; } -=item random_word [LENGTH] +=method random_word [LENGTH] Returns a random word from the word list, optionally of length LENGTH. @@ -219,7 +206,7 @@ sub _is_word_nocache { return 0; } -=item is_word STRING +=method is_word STRING Returns true if STRING is found in the word list, and false otherwise. @@ -254,7 +241,7 @@ sub _each_word_nocache { return; } -=item each_word CODE +=method each_word CODE Call CODE for each word in the word list. The current word will be passed into CODE as its only argument. @@ -268,7 +255,7 @@ sub each_word { return $self->_each_word_nocache(@_); } -=item anagrams STRING +=method anagrams STRING Returns a list of all permutations of STRING that are found in the word list. @@ -281,7 +268,7 @@ sub anagrams { return grep {$self->is_word($_)} all_permutations($word); } -=item words_like REGEX +=method words_like REGEX Returns a list containing all words in the word list which match REGEX. @@ -297,7 +284,7 @@ sub words_like { return @words; } -=item subwords_of STRING +=method subwords_of STRING Returns a list of words from the word list which can be made using the letters in STRING. @@ -311,59 +298,10 @@ sub subwords_of { return grep {$self->is_word($_)} all_subpermutations($string); } -=back - =head1 SEE ALSO L -=head1 AUTHOR - -Jesse Luehrs, C<< >> - -=head1 BUGS - -No known bugs. - -Please report any bugs through RT: email -C, or browse -L. - -=head1 SUPPORT - -You can find this documentation for this module with the perldoc command. - - perldoc Games::Word::Wordlist - -You can also look for information at: - -=over 4 - -=item * AnnoCPAN: Annotated CPAN documentation - -L - -=item * CPAN Ratings - -L - -=item * RT: CPAN's request tracker - -L - -=item * Search CPAN - -L - -=back - -=head1 COPYRIGHT AND LICENSE - -Copyright 2008-2009 Jesse Luehrs. - -This program is free software; you can redistribute it and/or modify it -under the same terms as Perl itself. - =cut 1; diff --git a/t/000-load.t b/t/000-load.t deleted file mode 100644 index e23f727..0000000 --- a/t/000-load.t +++ /dev/null @@ -1,10 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 2; - -my @modules = qw(Games::Word Games::Word::Wordlist); - -for my $module (@modules) { - use_ok $module or BAIL_OUT("couldn't use $module"); -} diff --git a/t/001-system-wordlist.t b/t/001-system-wordlist.t deleted file mode 100644 index 90f1a99..0000000 --- a/t/001-system-wordlist.t +++ /dev/null @@ -1,18 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 1; -use Games::Word::Wordlist; - -my $word_file = ''; -$word_file = '/usr/dict/words' if -r '/usr/dict/words'; -$word_file = '/usr/share/dict/words' if -r '/usr/share/dict/words'; - -SKIP: { - skip "Can't find a system word list", 1 if $word_file eq ''; - - my $wl = Games::Word::Wordlist->new($word_file); - open my $fh, '<', $word_file or die "Couldn't open $word_file"; - for (<$fh>) {} - is($wl->words, $., "we read in the correct number of words"); -} diff --git a/t/002-array-wordlist.t b/t/002-array-wordlist.t deleted file mode 100644 index 4f235c0..0000000 --- a/t/002-array-wordlist.t +++ /dev/null @@ -1,13 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 3; -use Games::Word::Wordlist; - -my @words = qw/foo bar baz/; -my $wl = Games::Word::Wordlist->new(\@words); -is($wl->words, 3, "created the correct number of words in the word list"); -$wl->add_words(['zab', 'rab', 'oof', 'foo']); -is($wl->words, 6, "adding words results in the correct number of words"); -$wl->remove_words(qw/rab foo quux/); -is($wl->words, 4, "deleting words results in the correct number of words"); diff --git a/t/003-system-wordlist-nocache.t b/t/003-system-wordlist-nocache.t deleted file mode 100644 index d8c0066..0000000 --- a/t/003-system-wordlist-nocache.t +++ /dev/null @@ -1,26 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 3; -use Test::Exception; -use Games::Word::Wordlist; - -my $word_file = ''; -$word_file = '/usr/dict/words' if -r '/usr/dict/words'; -$word_file = '/usr/share/dict/words' if -r '/usr/share/dict/words'; - -SKIP: { - skip "Can't find a system word list", 3 if $word_file eq ''; - - my $wl = Games::Word::Wordlist->new($word_file, cache => 0); - open my $fh, '<', $word_file or die "Couldn't open $word_file"; - for (<$fh>) {} - is($wl->words, $., "we read in the correct number of words"); - - throws_ok { $wl->add_words([qw/foo bar baz/]) } - qr/Can't add words to a non-cached word list/, - "adding words dies"; - throws_ok { $wl->remove_words("word", "throw") } - qr/Can't remove words from a non-cached word list/, - "removing words dies"; -} diff --git a/t/010-random-permutation.t b/t/010-random-permutation.t deleted file mode 100644 index 4adcda3..0000000 --- a/t/010-random-permutation.t +++ /dev/null @@ -1,15 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 51; -use Test::Deep; -use Games::Word qw/random_permutation/; - -is(random_permutation(""), "", "testing permutation of empty string"); - -for my $word (qw/foo bar baz quux blah/) { - for (1..10) { - cmp_deeply([split //, random_permutation $word], bag(split //, $word), - "random tests"); - } -} diff --git a/t/011-is-permutation.t b/t/011-is-permutation.t deleted file mode 100644 index e6e1abe..0000000 --- a/t/011-is-permutation.t +++ /dev/null @@ -1,18 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 20; -use Games::Word qw/random_permutation is_permutation/; - -ok( is_permutation("", ""), "testing empty string"); -ok( is_permutation("blah", "blah"), "testing same string"); -ok( is_permutation("blah", "alhb"), "testing permuted string"); -ok(!is_permutation("blah", "blh"), "testing word with letter deleted"); -ok(!is_permutation("blah", "blahs"), "testing word with letter added"); -ok(!is_permutation("blah", "blahh"), "testing word with repeated letter"); -ok( is_permutation("blaah", "hbala"), "testing word with duplicate letters"); -ok(!is_permutation("blaah", "bblah"), "more duplicate letter tests"); - -for (1..12) { - ok(is_permutation("blah", random_permutation("blah")), "random tests"); -} diff --git a/t/012-shared-letters.t b/t/012-shared-letters.t deleted file mode 100644 index 9e249c2..0000000 --- a/t/012-shared-letters.t +++ /dev/null @@ -1,38 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -use Games::Word qw/shared_letters shared_letters_by_position/; - -my @tests = ( - {a => "abcde", b => "edcba", sl => 5, slbp => 1, - slbp_full => [undef, undef, 'c', undef, undef]}, - {a => "", b => "", sl => 0, slbp => 0, - slbp_full => []}, - {a => "", b => "abcde", sl => 0, slbp => 0, - slbp_full => [undef, undef, undef, undef, undef]}, - {a => "aaa", b => "aa", sl => 2, slbp => 2, - slbp_full => ['a', 'a', undef]}, - {a => "abc", b => "abcde", sl => 3, slbp => 3, - slbp_full => ['a', 'b', 'c', undef, undef]}, - {a => "cde", b => "abcde", sl => 3, slbp => 0, - slbp_full => [undef, undef, undef, undef, undef]}, - {a => "abcba", b => "aabbc", sl => 5, slbp => 2, - slbp_full => ['a', undef, undef, 'b', undef]}, - {a => "abcde", b => "cdefg", sl => 3, slbp => 0, - slbp_full => [undef, undef, undef, undef, undef]}, - {a => "bacaa", b => "gabca", sl => 4, slbp => 2, - slbp_full => [undef, 'a', undef, undef, 'a']}, -); -plan tests => 3 * @tests; - -for (@tests) { - my %test = %$_; - my ($a, $b) = ($test{a}, $test{b}); - is(shared_letters($a, $b), $test{sl}, - "testing shared_letters: '$a' vs '$b'"); - is(shared_letters_by_position($a, $b), $test{slbp}, - "testing shared_letters_by_position: '$a' vs '$b'"); - is_deeply([shared_letters_by_position($a, $b)], $test{slbp_full}, - "testing shared_letters_by_position (list): '$a' vs '$b'"); -} diff --git a/t/013-random-string-from.t b/t/013-random-string-from.t deleted file mode 100644 index 78e907f..0000000 --- a/t/013-random-string-from.t +++ /dev/null @@ -1,22 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 23; -use Test::Deep; -use Test::Exception; -use Games::Word qw/random_string_from/; - -is(random_string_from("", 0), "", - "0 length random_string_from an empty string"); -throws_ok { random_string_from("", 5) } qr/invalid letter list/, - "random_string_from an empty string"; -is(random_string_from("abcde", 0), "", - "0 length random_string_from"); -my @letters = qw/a b c d e/; -for my $i (1..10) { - my $str = random_string_from join('', @letters), $i; - is(length $str, $i, "random_string_from returns the correct length"); - my $bag = subbagof(); - $bag->add(@letters) for 1..$i; - cmp_deeply([split(//, $str)], $bag, "random test of random_string_from"); -} diff --git a/t/014-substrings.t b/t/014-substrings.t deleted file mode 100644 index e61d264..0000000 --- a/t/014-substrings.t +++ /dev/null @@ -1,42 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -use Test::Deep; -use List::Util qw/sum/; -use Games::Word qw/is_substring all_substrings/; - -my %is_substring_tests = ( - "" => [""], - "abc", => ["", "abc", "ab", "ac"], - "aaba" => ["a", "aa", "aaa", "aab", "aba"], - "abcba" => ["aa", "bb", "c", "abc", "cba", "abba"], -); -my %isnt_substring_tests = ( - "" => ["a"], - "abc" => ["z", "ba", "baz", "abz"], - "aaba" => ["c", "abaa"], -); -my %all_substrings_tests = ( - "" => [''], - "a" => ['', "a"], - "ab" => ['', "a", "b", "ab"], - "aab" => ['', "a", "a", "b", "aa", "ab", "ab", "aab"], - "abc" => ['', "a", "b", "c", "ab", "ac", "bc", "abc"], -); -plan tests => (sum map { scalar @$_ } values %is_substring_tests, - values %isnt_substring_tests) + - keys %all_substrings_tests; - -while (my ($word, $substrings) = each %is_substring_tests) { - ok(is_substring($_, $word), "is '$_' a substring of '$word'?") - for @$substrings; -} -while (my ($word, $substrings) = each %isnt_substring_tests) { - ok(!is_substring($_, $word), "is '$_' not a substring of '$word'?") - for @$substrings; -} -while (my ($word, $substrings) = each %all_substrings_tests) { - cmp_deeply([all_substrings($word)], bag(@$substrings), - "do we get all of the substrings of '$word'?"); -} diff --git a/t/015-subpermutations.t b/t/015-subpermutations.t deleted file mode 100644 index 36e57d8..0000000 --- a/t/015-subpermutations.t +++ /dev/null @@ -1,34 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -use Test::Deep; -use List::Util qw/sum/; -use Games::Word qw/is_subpermutation all_subpermutations/; - -my %is_subpermutation_tests = ( - "" => [""], - "abc", => ["", "abc", "ab", "ac", "cb", "bac", "ca"], - "aaba" => ["a", "aa", "aaa", "aab", "aba"], - "abcba" => ["aa", "bb", "c", "abc", "cba", "abba", "bbaac", "caa"], -); -my %all_subpermutations_tests = ( - "" => [""], - "a" => ["", "a"], - "ab" => ["", "a", "b", "ab", "ba"], - "aab" => ["", "a", "a", "b", "aa", "ab", "ab", "ba", "ba", "aa", - "aab", "aab", "aba", "aba", "baa", "baa"], - "abc" => ["", "a", "b", "c", "ab", "ac", "bc", "ba", "ca", "cb", - "abc", "acb", "bac", "bca", "cab", "cba"], -); -plan tests => (sum map { scalar @$_ } values %is_subpermutation_tests) + - keys %all_subpermutations_tests; - -while (my ($word, $subpermutations) = each %is_subpermutation_tests) { - ok(is_subpermutation($_, $word), "is '$_' a subpermutation of '$word'?") - for @$subpermutations; -} -while (my ($word, $subpermutations) = each %all_subpermutations_tests) { - cmp_deeply([all_subpermutations($word)], bag(@$subpermutations), - "do we get all of the subpermutations of '$word'?"); -} diff --git a/t/020-random-word.t b/t/020-random-word.t deleted file mode 100644 index b642c27..0000000 --- a/t/020-random-word.t +++ /dev/null @@ -1,26 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 6; -use Games::Word::Wordlist; - -my $wl = Games::Word::Wordlist->new(['foo', 'bar', 'baz', 'quux']); - -my $word = $wl->random_word; -ok(defined($word), "random_word actually returned a word"); -like($word, qr/^(foo|bar|baz|quux)$/, - "testing that the word is actually in the word list"); - -$word = $wl->random_word(4); -is($word, 'quux', "testing random_word with a given length"); - -$word = $wl->random_word(3); -like($word, qr/^(foo|bar|baz)$/, - "testing that the word was correct"); - -is($wl->random_word(5), undef, - "random_word returns undef if no words are found"); - -my $wl2 = Games::Word::Wordlist->new([]); -is($wl2->random_word, undef, - "random word returns undef with an empty word list"); diff --git a/t/021-is-word.t b/t/021-is-word.t deleted file mode 100644 index 2c6045f..0000000 --- a/t/021-is-word.t +++ /dev/null @@ -1,12 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 10; -use Test::Exception; -use Games::Word::Wordlist; - -my $wl = Games::Word::Wordlist->new(['foo', 'bar', 'baz']); -for (1..10) { - ok($wl->is_word($wl->random_word), - "testing checking to see if a random word from the word list is a word"); -} diff --git a/t/022-random-word-nocache.t b/t/022-random-word-nocache.t deleted file mode 100644 index d5c9c19..0000000 --- a/t/022-random-word-nocache.t +++ /dev/null @@ -1,32 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 4; -use Test::Exception; -use Games::Word::Wordlist; - -my $word_file = ''; -$word_file = '/usr/dict/words' if -r '/usr/dict/words'; -$word_file = '/usr/share/dict/words' if -r '/usr/share/dict/words'; - -SKIP: { - skip "Can't find a system word list", 4 if $word_file eq ''; - - my $wl = Games::Word::Wordlist->new($word_file, cache => 0); - my $word = $wl->random_word; - ok(defined($word), "random_word actually returned a word"); - - open my $fh, '<', $word_file; - my $passed = 0; - for (<$fh>) { - chomp; - $passed = 1 if $word eq $_; - } - ok($passed, "testing that the word is actually in the word list"); - - $word = $wl->random_word(4); - is(length $word, 4, "testing random_word with a given length"); - - is($wl->random_word(999), undef, - "random_word returns undef if no words are found"); -} diff --git a/t/023-is-word-nocache.t b/t/023-is-word-nocache.t deleted file mode 100644 index 3b51e15..0000000 --- a/t/023-is-word-nocache.t +++ /dev/null @@ -1,21 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 11; -use Test::Exception; -use Games::Word::Wordlist; - -my $word_file = ''; -$word_file = '/usr/dict/words' if -r '/usr/dict/words'; -$word_file = '/usr/share/dict/words' if -r '/usr/share/dict/words'; - -SKIP: { - skip "Can't find a system word list", 11 if $word_file eq ''; - - my $wl = Games::Word::Wordlist->new($word_file, cache => 0); - for (1..10) { - ok($wl->is_word($wl->random_word), - "checking to see if a random word from the word list is a word"); - } - ok(!$wl->is_word("notaword"), "testing is_word with a non-word"); -} diff --git a/t/024-anagrams.t b/t/024-anagrams.t deleted file mode 100644 index 9de5ad0..0000000 --- a/t/024-anagrams.t +++ /dev/null @@ -1,14 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 1; -use Test::Deep; -use Games::Word::Wordlist; - -my @words = qw/stop spot tops post posts stops spartan poster pot sop spa/; - -my $wl = Games::Word::Wordlist->new(\@words); -my @anagrams = $wl->anagrams("stop"); - -cmp_deeply(\@anagrams, bag('stop', 'spot', 'tops', 'post'), - "anagrams returns the correct words"); diff --git a/t/025-subwords.t b/t/025-subwords.t deleted file mode 100644 index b117158..0000000 --- a/t/025-subwords.t +++ /dev/null @@ -1,14 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 1; -use Test::Deep; -use Games::Word::Wordlist; - -my @words = qw/stop spot tops post posts stops spartan poster pot sop spa/; - -my $wl = Games::Word::Wordlist->new(\@words); -my @subwords = $wl->subwords_of("stop"); - -cmp_deeply(\@subwords, bag('stop', 'spot', 'tops', 'post', 'pot', 'sop'), - "subwords_of returns the correct words"); diff --git a/t/anagrams.t b/t/anagrams.t new file mode 100644 index 0000000..68b18d4 --- /dev/null +++ b/t/anagrams.t @@ -0,0 +1,16 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +use Games::Word::Wordlist; + +my @words = qw/stop spot tops post posts stops spartan poster pot sop spa/; + +my $wl = Games::Word::Wordlist->new(\@words); +my @anagrams = $wl->anagrams("stop"); + +is_deeply([sort @anagrams], [qw(post spot stop tops)], + "anagrams returns the correct words"); + +done_testing; diff --git a/t/array-wordlist.t b/t/array-wordlist.t new file mode 100644 index 0000000..f949860 --- /dev/null +++ b/t/array-wordlist.t @@ -0,0 +1,16 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +use Games::Word::Wordlist; + +my @words = qw/foo bar baz/; +my $wl = Games::Word::Wordlist->new(\@words); +is($wl->words, 3, "created the correct number of words in the word list"); +$wl->add_words(['zab', 'rab', 'oof', 'foo']); +is($wl->words, 6, "adding words results in the correct number of words"); +$wl->remove_words(qw/rab foo quux/); +is($wl->words, 4, "deleting words results in the correct number of words"); + +done_testing; diff --git a/t/is-permutation.t b/t/is-permutation.t new file mode 100644 index 0000000..378d992 --- /dev/null +++ b/t/is-permutation.t @@ -0,0 +1,21 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +use Games::Word qw(random_permutation is_permutation); + +ok( is_permutation("", ""), "testing empty string"); +ok( is_permutation("blah", "blah"), "testing same string"); +ok( is_permutation("blah", "alhb"), "testing permuted string"); +ok(!is_permutation("blah", "blh"), "testing word with letter deleted"); +ok(!is_permutation("blah", "blahs"), "testing word with letter added"); +ok(!is_permutation("blah", "blahh"), "testing word with repeated letter"); +ok( is_permutation("blaah", "hbala"), "testing word with duplicate letters"); +ok(!is_permutation("blaah", "bblah"), "more duplicate letter tests"); + +for (1..12) { + ok(is_permutation("blah", random_permutation("blah")), "random tests"); +} + +done_testing; diff --git a/t/is-word-nocache.t b/t/is-word-nocache.t new file mode 100644 index 0000000..7ca6939 --- /dev/null +++ b/t/is-word-nocache.t @@ -0,0 +1,23 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +use Games::Word::Wordlist; + +my $word_file = ''; +$word_file = '/usr/dict/words' if -r '/usr/dict/words'; +$word_file = '/usr/share/dict/words' if -r '/usr/share/dict/words'; + +SKIP: { + skip "Can't find a system word list", 11 if $word_file eq ''; + + my $wl = Games::Word::Wordlist->new($word_file, cache => 0); + for (1..10) { + ok($wl->is_word($wl->random_word), + "checking to see if a random word from the word list is a word"); + } + ok(!$wl->is_word("notaword"), "testing is_word with a non-word"); +} + +done_testing; diff --git a/t/is-word.t b/t/is-word.t new file mode 100644 index 0000000..a7daff0 --- /dev/null +++ b/t/is-word.t @@ -0,0 +1,14 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +use Games::Word::Wordlist; + +my $wl = Games::Word::Wordlist->new(['foo', 'bar', 'baz']); +for (1..10) { + ok($wl->is_word($wl->random_word), + "testing checking to see if a random word from the word list is a word"); +} + +done_testing; diff --git a/t/random-permutation.t b/t/random-permutation.t new file mode 100644 index 0000000..ca9f004 --- /dev/null +++ b/t/random-permutation.t @@ -0,0 +1,20 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +use Games::Word qw(random_permutation); + +is(random_permutation(""), "", "testing permutation of empty string"); + +for my $word (qw/foo bar baz quux blah/) { + for (1..10) { + is_deeply( + [sort split //, random_permutation($word)], + [sort split //, $word], + "random tests" + ); + } +} + +done_testing; diff --git a/t/random-string-from.t b/t/random-string-from.t new file mode 100644 index 0000000..b4abc89 --- /dev/null +++ b/t/random-string-from.t @@ -0,0 +1,28 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Deep; +use Test::Fatal; + +use Games::Word qw(random_string_from); + +is(random_string_from("", 0), "", + "0 length random_string_from an empty string"); +like( + exception { random_string_from("", 5) }, + qr/invalid letter list/, + "random_string_from an empty string" +); +is(random_string_from("abcde", 0), "", + "0 length random_string_from"); +my @letters = qw/a b c d e/; +for my $i (1..10) { + my $str = random_string_from join('', @letters), $i; + is(length $str, $i, "random_string_from returns the correct length"); + my $bag = subbagof(); + $bag->add(@letters) for 1..$i; + cmp_deeply([split(//, $str)], $bag, "random test of random_string_from"); +} + +done_testing; diff --git a/t/random-word-nocache.t b/t/random-word-nocache.t new file mode 100644 index 0000000..0c7fb1d --- /dev/null +++ b/t/random-word-nocache.t @@ -0,0 +1,34 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +use Games::Word::Wordlist; + +my $word_file = ''; +$word_file = '/usr/dict/words' if -r '/usr/dict/words'; +$word_file = '/usr/share/dict/words' if -r '/usr/share/dict/words'; + +SKIP: { + skip "Can't find a system word list", 4 if $word_file eq ''; + + my $wl = Games::Word::Wordlist->new($word_file, cache => 0); + my $word = $wl->random_word; + ok(defined($word), "random_word actually returned a word"); + + open my $fh, '<', $word_file; + my $passed = 0; + for (<$fh>) { + chomp; + $passed = 1 if $word eq $_; + } + ok($passed, "testing that the word is actually in the word list"); + + $word = $wl->random_word(4); + is(length $word, 4, "testing random_word with a given length"); + + is($wl->random_word(999), undef, + "random_word returns undef if no words are found"); +} + +done_testing; diff --git a/t/random-word.t b/t/random-word.t new file mode 100644 index 0000000..6c5801d --- /dev/null +++ b/t/random-word.t @@ -0,0 +1,29 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +use Games::Word::Wordlist; + +my $wl = Games::Word::Wordlist->new(['foo', 'bar', 'baz', 'quux']); + +my $word = $wl->random_word; +ok(defined($word), "random_word actually returned a word"); +like($word, qr/^(foo|bar|baz|quux)$/, + "testing that the word is actually in the word list"); + +$word = $wl->random_word(4); +is($word, 'quux', "testing random_word with a given length"); + +$word = $wl->random_word(3); +like($word, qr/^(foo|bar|baz)$/, + "testing that the word was correct"); + +is($wl->random_word(5), undef, + "random_word returns undef if no words are found"); + +my $wl2 = Games::Word::Wordlist->new([]); +is($wl2->random_word, undef, + "random word returns undef with an empty word list"); + +done_testing; diff --git a/t/shared-letters.t b/t/shared-letters.t new file mode 100644 index 0000000..238ed23 --- /dev/null +++ b/t/shared-letters.t @@ -0,0 +1,40 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +use Games::Word qw(shared_letters shared_letters_by_position); + +my @tests = ( + {a => "abcde", b => "edcba", sl => 5, slbp => 1, + slbp_full => [undef, undef, 'c', undef, undef]}, + {a => "", b => "", sl => 0, slbp => 0, + slbp_full => []}, + {a => "", b => "abcde", sl => 0, slbp => 0, + slbp_full => [undef, undef, undef, undef, undef]}, + {a => "aaa", b => "aa", sl => 2, slbp => 2, + slbp_full => ['a', 'a', undef]}, + {a => "abc", b => "abcde", sl => 3, slbp => 3, + slbp_full => ['a', 'b', 'c', undef, undef]}, + {a => "cde", b => "abcde", sl => 3, slbp => 0, + slbp_full => [undef, undef, undef, undef, undef]}, + {a => "abcba", b => "aabbc", sl => 5, slbp => 2, + slbp_full => ['a', undef, undef, 'b', undef]}, + {a => "abcde", b => "cdefg", sl => 3, slbp => 0, + slbp_full => [undef, undef, undef, undef, undef]}, + {a => "bacaa", b => "gabca", sl => 4, slbp => 2, + slbp_full => [undef, 'a', undef, undef, 'a']}, +); + +for (@tests) { + my %test = %$_; + my ($a, $b) = ($test{a}, $test{b}); + is(shared_letters($a, $b), $test{sl}, + "testing shared_letters: '$a' vs '$b'"); + is(shared_letters_by_position($a, $b), $test{slbp}, + "testing shared_letters_by_position: '$a' vs '$b'"); + is_deeply([shared_letters_by_position($a, $b)], $test{slbp_full}, + "testing shared_letters_by_position (list): '$a' vs '$b'"); +} + +done_testing; diff --git a/t/subpermutations.t b/t/subpermutations.t new file mode 100644 index 0000000..bf16ec3 --- /dev/null +++ b/t/subpermutations.t @@ -0,0 +1,36 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +use Games::Word qw(is_subpermutation all_subpermutations); + +my %is_subpermutation_tests = ( + "" => [""], + "abc", => ["", "abc", "ab", "ac", "cb", "bac", "ca"], + "aaba" => ["a", "aa", "aaa", "aab", "aba"], + "abcba" => ["aa", "bb", "c", "abc", "cba", "abba", "bbaac", "caa"], +); +my %all_subpermutations_tests = ( + "" => [""], + "a" => ["", "a"], + "ab" => ["", "a", "b", "ab", "ba"], + "aab" => ["", "a", "a", "b", "aa", "ab", "ab", "ba", "ba", "aa", + "aab", "aab", "aba", "aba", "baa", "baa"], + "abc" => ["", "a", "b", "c", "ab", "ac", "bc", "ba", "ca", "cb", + "abc", "acb", "bac", "bca", "cab", "cba"], +); + +for my $word (keys %is_subpermutation_tests) { + ok(is_subpermutation($_, $word), "is '$_' a subpermutation of '$word'?") + for @{ $is_subpermutation_tests{$word} }; +} +for my $word (keys %all_subpermutations_tests) { + is_deeply( + [sort(all_subpermutations($word))], + [sort(@{ $all_subpermutations_tests{$word} })], + "do we get all of the subpermutations of '$word'?" + ); +} + +done_testing; diff --git a/t/substrings.t b/t/substrings.t new file mode 100644 index 0000000..c4f478b --- /dev/null +++ b/t/substrings.t @@ -0,0 +1,43 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +use Games::Word qw(is_substring all_substrings); + +my %is_substring_tests = ( + "" => [""], + "abc", => ["", "abc", "ab", "ac"], + "aaba" => ["a", "aa", "aaa", "aab", "aba"], + "abcba" => ["aa", "bb", "c", "abc", "cba", "abba"], +); +my %isnt_substring_tests = ( + "" => ["a"], + "abc" => ["z", "ba", "baz", "abz"], + "aaba" => ["c", "abaa"], +); +my %all_substrings_tests = ( + "" => [''], + "a" => ['', "a"], + "ab" => ['', "a", "b", "ab"], + "aab" => ['', "a", "a", "b", "aa", "ab", "ab", "aab"], + "abc" => ['', "a", "b", "c", "ab", "ac", "bc", "abc"], +); + +for my $word (keys %is_substring_tests) { + ok(is_substring($_, $word), "is '$_' a substring of '$word'?") + for @{ $is_substring_tests{$word} }; +} +for my $word (keys %isnt_substring_tests) { + ok(!is_substring($_, $word), "is '$_' not a substring of '$word'?") + for @{ $isnt_substring_tests{$word} }; +} +for my $word (keys %all_substrings_tests) { + is_deeply( + [sort(all_substrings($word))], + [sort(@{ $all_substrings_tests{$word} })], + "do we get all of the substrings of '$word'?" + ); +} + +done_testing; diff --git a/t/subwords.t b/t/subwords.t new file mode 100644 index 0000000..30b39b2 --- /dev/null +++ b/t/subwords.t @@ -0,0 +1,16 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +use Games::Word::Wordlist; + +my @words = qw/stop spot tops post posts stops spartan poster pot sop spa/; + +my $wl = Games::Word::Wordlist->new(\@words); +my @subwords = $wl->subwords_of("stop"); + +is_deeply([sort @subwords], [qw(post pot sop spot stop tops)], + "subwords_of returns the correct words"); + +done_testing; diff --git a/t/system-wordlist-nocache.t b/t/system-wordlist-nocache.t new file mode 100644 index 0000000..417a061 --- /dev/null +++ b/t/system-wordlist-nocache.t @@ -0,0 +1,33 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Fatal; + +use Games::Word::Wordlist; + +my $word_file = ''; +$word_file = '/usr/dict/words' if -r '/usr/dict/words'; +$word_file = '/usr/share/dict/words' if -r '/usr/share/dict/words'; + +SKIP: { + skip "Can't find a system word list", 3 if $word_file eq ''; + + my $wl = Games::Word::Wordlist->new($word_file, cache => 0); + open my $fh, '<', $word_file or die "Couldn't open $word_file"; + for (<$fh>) {} + is($wl->words, $., "we read in the correct number of words"); + + like( + exception { $wl->add_words([qw/foo bar baz/]) }, + qr/Can't add words to a non-cached word list/, + "adding words dies" + ); + like( + exception { $wl->remove_words("word", "throw") }, + qr/Can't remove words from a non-cached word list/, + "removing words dies" + ); +} + +done_testing; diff --git a/t/system-wordlist.t b/t/system-wordlist.t new file mode 100644 index 0000000..b4bcdda --- /dev/null +++ b/t/system-wordlist.t @@ -0,0 +1,21 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +use Games::Word::Wordlist; + +my $word_file = ''; +$word_file = '/usr/dict/words' if -r '/usr/dict/words'; +$word_file = '/usr/share/dict/words' if -r '/usr/share/dict/words'; + +SKIP: { + skip "Can't find a system word list", 1 if $word_file eq ''; + + my $wl = Games::Word::Wordlist->new($word_file); + open my $fh, '<', $word_file or die "Couldn't open $word_file"; + for (<$fh>) {} + is($wl->words, $., "we read in the correct number of words"); +} + +done_testing; -- cgit v1.2.3-54-g00ecf