Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

file 56 lines (40 sloc) 1.702 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56
#!/usr/bin/perl

# Test the RPC::XML::Parser class negative conditions

use strict;
use warnings;
use vars qw($p $retval);

use Test::More tests => 14;

# Create a dummy class to use for attempts to call methods within the
# RPC::XML::Parser class:
package BadParser;

use base 'RPC::XML::Parser';

package main;

# This is the pattern we are looking for in the error messages:
my $errtext = qr/should have been overridden by the BadParser class/;

# First, the constructor:
eval { $p = BadParser->new() };
ok(! defined $p, 'RPC::XML::Parser did not instantiate');
like($@, $errtext, 'Correctly-set error message in $@');

# Fine! We'll *force* an object into that class:
$p = bless {}, 'BadParser';

# *Now* try and stop me from calling methods!
$retval = eval { $p->parse(); 1 };
ok(! $retval, '::parse correctly failed to run');
like($@, $errtext, 'Correctly-set error message in $@');

$retval = eval { $p->parse_more(); 1 };
ok(! $retval, '::parse_more correctly failed to run');
like($@, $errtext, 'Correctly-set error message in $@');

$retval = eval { $p->parse_done(); 1 };
ok(! $retval, '::parse_done correctly failed to run');
like($@, $errtext, 'Correctly-set error message in $@');

# Try them as static methods:
$retval = eval { BadParser->parse(); 1 };
ok(! $retval, '::parse correctly failed to run');
like($@, $errtext, 'Correctly-set error message in $@');

$retval = eval { BadParser->parse_more(); 1 };
ok(! $retval, '::parse_more correctly failed to run');
like($@, $errtext, 'Correctly-set error message in $@');

$retval = eval { BadParser->parse_done(); 1 };
ok(! $retval, '::parse_done correctly failed to run');
like($@, $errtext, 'Correctly-set error message in $@');

exit;
Something went wrong with that request. Please try again.