Skip to content

Instantly share code, notes, and snippets.

@kablamo

kablamo/find_missing_tests.pl

Created February 3, 2014 13:44
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save kablamo/8784025 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save kablamo/8784025 to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. kablamo created this gist Feb 3, 2014.
    123 changes: 123 additions & 0 deletions find_missing_tests.pl
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,123 @@
    #!/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;
    }