view release on metacpan or  search on metacpan

t/lib/Test/RxTester.pm  view on Meta::CPAN

  }

  return ($ok, @diag);
}

sub run_tests {
  my ($self, @spec_names) = @_;

  my $spec_data = $self->{spec};

  if (!@spec_names) {
    @spec_names = sort keys %$spec_data;
  }

  SPEC: for my $spec_name (@spec_names) {
    my $spec = $spec_data->{ $spec_name }
      or die "invalid spec name $spec_name";

    Test::More::diag "testing $spec_name";

    my $rx = Data::Rx->new({ sort_keys => 1 });

    if ($spec->{'composedtype'}) {
      my $rc =
        eval { $rx->learn_type($spec->{'composedtype'}{'uri'},
                               $spec->{'composedtype'}{'schema'});
               1 };
      my $error = $@;

      if ($spec->{'composedtype'}{'invalid'}) {
        Test::More::ok($error && !$rc, "BAD COMPOSED TYPE: $spec_name");
        next SPEC;
      }

      $rx->add_prefix(@{$spec->{'composedtype'}{'prefix'}})
        if $spec->{'composedtype'}{'prefix'};
    }

    my $schema = eval { $rx->make_schema($spec->{schema}) };
    my $error  = $@;

    if ($spec->{invalid}) {
      Test::More::ok($error && ! $schema, "$spec_name should be INVALID");
      next SPEC;
    }

    Carp::croak("couldn't produce schema for valid input ($spec_name): $error")
      unless $schema;

    Carp::croak("rx attribute not set in schema ($spec_name)")
      unless $schema->rx;

    for my $test_name (sort keys %{ $spec->{test} }) {
      my $test_spec = $spec->{test}{$test_name};

      my $input  = $self->_decode_json("[ $test_spec->{input} ]")->[0];

      my $method = @{ $test_spec->{errors} } ? 'assert_fail' : 'assert_pass';

      TODO: {
        my ($source, $entry) = split m{/}, $test_name, 2;
        my $reason = fudge_reason($spec_name, $source, $entry);

        local our $TODO = $reason if $reason;
        $self->$method({
          schema      => $schema,
          schema_desc => $spec_name,
          schema_spec => $spec->{schema},
          input       => $input,
          input_desc  => $test_name,
          want        => $test_spec->{errors},
        });
      }
    }
  }
}

1;