Skip to content

Instantly share code, notes, and snippets.

@kablamo
Created February 3, 2014 13:44
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save kablamo/8784025 to your computer and use it in GitHub Desktop.
Save kablamo/8784025 to your computer and use it in GitHub Desktop.
This script finds all the example queries in the DDG::Goodie namespace and checks to see which ones are tested. The ones that are not tested are printed out.
#!/usr/bin/env perl
use strict;
use warnings;
use v5.10.1;
use Clone qw/clone/;
use DDP;
use List::AllUtils qw/first_index/;
use PPI;
use Path::Tiny;
{
my $example_queries = find_example_queries();
my @filenames = sort keys %$example_queries;
my $dir = path("t");
foreach my $filename (@filenames) {
my $expected_queries = $example_queries->{$filename};
$filename =~ s/.pm$/.t/;
my $file = $dir->child($filename);
my $missing_queries = find_missing_queries($expected_queries, $file)
|| next;
display_missing_queries($missing_queries, $file);
}
}
sub find_missing_queries {
my ($expected_queries, $file) = @_;
my $doc = PPI::Document->new($file->stringify) || return;
my $statements = $doc->find('Statement');
foreach my $statement (@$statements) {
next unless $statement->content =~ /ddg_.*_test/;
my @tokens = $statement->tokens;
my $token = shift @tokens;
shift_until(\@tokens, 'DDG::Goodie::');
shift_until(\@tokens, ']');
shift_until(\@tokens, ',');
while (@tokens) {
my $previous_token = shift_until(\@tokens, 'test_zci');
last unless @tokens;
$previous_token =~ s/^['"](.*)['"]$/$1/; # rm single and double quotes
# delete $previous_token from @expected_queries
my $i = first_index { $previous_token eq $_ } @$expected_queries;
splice(@$expected_queries, $i, 1) unless $i == -1;
}
}
return $expected_queries;
}
sub display_missing_queries {
my ($queries, $file) = @_;
return unless @$queries;
say $file;
say ">> $_" for @$queries;
say "";
}
sub shift_until {
my $tokens = shift;
my $regex = shift;
my $token = shift @$tokens;
my $previous;
while ($token && $token !~ /$regex/) {
$previous = $token unless $token =~ /^\s+$/ || $token eq '=>';
$token = shift @$tokens;
}
return $previous;
}
sub find_example_queries {
my $dir = path("lib/DDG/Goodie");
my $data;
for my $file ($dir->children) {
my $doc = PPI::Document->new($file->stringify);
my $statements = $doc->find( 'Statement' );
my @example_queries;
foreach my $statement (@$statements) {
my $code = $statement->content;
next unless $code =~ /(primary|secondary)_example_queries/;
#say ":: " . $statement->content;
my @tokens = $statement->tokens;
foreach my $token (@tokens) {
next if $token =~ /^\s+$/;
next if $token eq "\n";
next if $token eq ";";
next if $token eq ",";
next if $token =~ /(primary|secondary)_example_queries/;
$token =~ s/^['"](.*)['"]$/$1/; # rm single and double quotes
push @example_queries, $token;
#say ">>" . $token . "<<";
}
}
my $basename = $file->basename;
$data->{$basename} = \@example_queries;
#say "";
}
return $data;
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment