Permalink
Browse files

Add Paul Webster's test for edge-case YAML input.

  • Loading branch information...
1 parent 23a38aa commit 2b27ce2c0edecb73af625bf921e7e4758a0adfc1 @rcaputo committed May 6, 2012
Showing with 117 additions and 0 deletions.
  1. +117 −0 t/10_units/05_filters/51_reference_die.t
@@ -0,0 +1,117 @@
+#!/usr/bin/perl
+# vim: ts=2 sw=2 expandtab
+
+use warnings;
+use strict;
+
+use POE::Filter::Reference;
+use Test::More;
+
+BEGIN {
+ eval 'use YAML';
+ if ($@) {
+ plan skip_all => 'YAML module not available';
+ }
+ else {
+ plan tests => 5;
+ }
+}
+
+# Create a YAML stream a la Perl.
+# Baseline. Verify the basic YAML is liked.
+
+my $test_data = {
+ test => 1,
+ foo => [1, 2],
+ bar => int(rand(999)),
+};
+
+my $basic_yaml = YAML::Dump($test_data);
+
+# Baseline test. Make sure the Perl YAML can be decoded.
+
+ok(
+ doesnt_die($basic_yaml),
+ "basic yaml doesn't die"
+);
+
+# Some YAML producers don't include newlines.
+# This reportedly causes problems for Perl's YAML parser.
+
+{
+ my $no_newline_yaml = $basic_yaml;
+ chomp $no_newline_yaml;
+
+ ok(
+ dies_when_allowed($no_newline_yaml),
+ "yaml without newlines dies when allowed"
+ );
+
+ ok(
+ exception_caught($no_newline_yaml),
+ "yaml without newlines returns error when caught"
+ );
+}
+
+# YAML supports a "...\n" record terminator.
+# Perl's YAML is reported to dislike this.
+
+{
+ my $terminated_yaml = $basic_yaml . "...\n";
+
+ ok(
+ dies_when_allowed($terminated_yaml),
+ "terminated_yaml dies when allowed"
+ );
+
+ ok(
+ exception_caught($terminated_yaml),
+ "terminated_yaml returns error when caught"
+ );
+}
+
+exit;
+
+sub doesnt_die {
+ my $yaml = shift();
+
+ my $pfr = POE::Filter::Reference->new('YAML', 0, 0);
+ my $encoded = length($yaml) . "\0" . $yaml;
+
+ my $decoded = $pfr->get([ $encoded ]);
+
+ return(
+ defined($decoded) &&
+ (ref($decoded) eq 'ARRAY') &&
+ (@$decoded == 1) &&
+ (ref($decoded->[0]) eq 'HASH')
+ );
+}
+
+sub dies_when_allowed {
+ my $yaml = shift();
+
+ my $pfr = POE::Filter::Reference->new('YAML', 0, 0);
+ my $encoded = length($yaml) . "\0" . $yaml;
+
+ $@ = undef;
+ my $decoded = eval { $pfr->get([ $encoded ]); };
+
+ return !!$@;
+}
+
+sub exception_caught {
+ my $yaml = shift();
+
+ my $pfr = POE::Filter::Reference->new('YAML', 0, 1);
+ my $encoded = length($yaml) . "\0" . $yaml;
+
+ my $decoded = eval { $pfr->get([ $encoded ]); };
+
+ return(
+ defined($decoded) &&
+ (ref($decoded) eq 'ARRAY') &&
+ (@$decoded == 1) &&
+ (ref($decoded->[0]) eq '')
+ );
+}

0 comments on commit 2b27ce2

Please sign in to comment.