Commit | Line | Data |
b10dde3a |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use File::Slurp qw( write_file ); |
7 | use PPI; |
8 | |
9 | rewrite_doc($_) for grep { -w } @ARGV; |
10 | |
11 | sub rewrite_doc { |
12 | my $file = shift; |
13 | |
14 | my $doc = PPI::Document->new($file); |
15 | |
16 | return unless $doc =~ /Test::Exception/; |
17 | |
18 | print $file, "\n"; |
19 | |
20 | my $pattern = sub { |
21 | my $elt = $_[1]; |
22 | |
23 | return 1 |
24 | if $elt->isa('PPI::Statement') |
25 | && $elt->content() |
26 | =~ /^\s*(?:::)?(?:lives_|throws_|dies_)(?:ok|and)/; |
27 | |
28 | return 0; |
29 | }; |
30 | |
31 | for my $elt ( @{ $doc->find($pattern) || [] } ) { |
32 | transform_statement($elt); |
33 | } |
34 | |
35 | my $content = $doc->content(); |
36 | $content =~ s/Test::Exception/Test::Fatal/g; |
37 | |
38 | write_file( $file, $content ); |
39 | } |
40 | |
41 | sub transform_statement { |
42 | my $stmt = shift; |
43 | |
44 | my @children = $stmt->schildren; |
45 | |
46 | my $func = shift @children; |
47 | |
48 | my $colons = $func =~ /^::/ ? '::' : q{}; |
49 | |
50 | my $code; |
51 | if ( $func =~ /lives_/ ) { |
52 | $code = function( |
53 | $colons . 'is', |
54 | $children[0], |
55 | 'undef', |
56 | $children[1] |
57 | ); |
58 | } |
59 | elsif ( $func =~ /dies_/ ) { |
60 | $code = function( |
61 | $colons . 'isnt', |
62 | $children[0], |
63 | 'undef', |
64 | $children[1] |
65 | ); |
66 | } |
67 | elsif ( $func =~ /throws_/ ) { |
68 | |
69 | # $children[2] is always a comma if it exists |
70 | if ( $children[1]->isa('PPI::Token::QuoteLike::Regexp') ) { |
71 | $code = function( |
72 | $colons . 'like', |
73 | $children[0], |
74 | $children[1], |
75 | $children[3] |
76 | ); |
77 | } |
78 | else { |
79 | $code = function( |
80 | $colons . 'is', |
81 | $children[0], |
82 | $children[1], |
83 | $children[3] |
84 | ); |
85 | } |
86 | } |
87 | |
88 | $stmt->insert_before($code); |
89 | $stmt->remove; |
90 | } |
91 | |
92 | sub function { |
93 | my $func = shift; |
94 | my $exception = shift; |
95 | my $expect = shift; |
96 | my $desc = shift; |
97 | |
98 | my $exc_func = $func =~ /^::/ ? '::exception' : 'exception'; |
99 | |
100 | my @code; |
101 | |
102 | push @code, |
103 | PPI::Token::Word->new($func), |
104 | PPI::Token::Structure->new('('), |
105 | PPI::Token::Whitespace->new(q{ }), |
106 | PPI::Token::Word->new($exc_func), |
107 | PPI::Token::Whitespace->new(q{ }), |
108 | $exception->clone, |
109 | PPI::Token::Operator->new(','), |
110 | PPI::Token::Whitespace->new(q{ }), |
111 | ( ref $expect ? $expect->clone : PPI::Token::Word->new($expect) ); |
112 | |
113 | if ( $desc && $desc->isa('PPI::Token::Quote') ) { |
114 | push @code, PPI::Token::Operator->new(','), |
115 | PPI::Token::Whitespace->new(q{ }), |
116 | $desc->clone; |
117 | } |
118 | |
119 | push @code, |
120 | PPI::Token::Whitespace->new(q{ }), |
121 | PPI::Token::Structure->new(')'), |
122 | PPI::Token::Structure->new(';'); |
123 | |
124 | my $stmt = PPI::Statement->new; |
125 | $stmt->add_element($_) for @code; |
126 | |
127 | return $stmt; |
128 | } |