diff options
Diffstat (limited to 'external/perl/Text-Template-1.56/t')
22 files changed, 1386 insertions, 0 deletions
diff --git a/external/perl/Text-Template-1.56/t/author-pod-syntax.t b/external/perl/Text-Template-1.56/t/author-pod-syntax.t new file mode 100644 index 000000000000..2233af0821cc --- /dev/null +++ b/external/perl/Text-Template-1.56/t/author-pod-syntax.t @@ -0,0 +1,15 @@ +#!perl + +BEGIN { + unless ($ENV{AUTHOR_TESTING}) { + print qq{1..0 # SKIP these tests are for testing by the author\n}; + exit + } +} + +# This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. +use strict; use warnings; +use Test::More; +use Test::Pod 1.41; + +all_pod_files_ok(); diff --git a/external/perl/Text-Template-1.56/t/author-signature.t b/external/perl/Text-Template-1.56/t/author-signature.t new file mode 100644 index 000000000000..c81a09395cb7 --- /dev/null +++ b/external/perl/Text-Template-1.56/t/author-signature.t @@ -0,0 +1,21 @@ +#!perl -w + +BEGIN { + unless ($ENV{AUTHOR_TESTING}) { + print qq{1..0 # SKIP these tests are for testing by the author\n}; + exit + } +} + +# This file was automatically generated by Dist::Zilla::Plugin::AuthorSignatureTest + +use strict; +use warnings; +use Test::More; + +unless (eval { require Test::Signature; 1 }) { + plan skip_all => 'Test::Signature is required for this test'; +} + +Test::Signature::signature_ok(); +done_testing; diff --git a/external/perl/Text-Template-1.56/t/basic.t b/external/perl/Text-Template-1.56/t/basic.t new file mode 100755 index 000000000000..4b7c711215d2 --- /dev/null +++ b/external/perl/Text-Template-1.56/t/basic.t @@ -0,0 +1,179 @@ +#!perl +# +# Tests of basic, essential functionality +# + +use strict; +use warnings; +use Test::More tests => 34; +use File::Temp; + +my $tmpfile = File::Temp->new; + +use_ok 'Text::Template' or exit 1; + +$X::v = $Y::v = 0; # Suppress `var used only once' + +my $template_1 = <<EOM; +We will put value of \$v (which is "abc") here -> {\$v} +We will evaluate 1+1 here -> {1 + 1} +EOM + +# (1) Construct temporary template file for testing +# file operations +my $TEMPFILE = $tmpfile->filename; + +eval { + open my $tmp, '>', $TEMPFILE + or die "Couldn't write tempfile $TEMPFILE: $!"; + + print $tmp $template_1; + close $tmp; + + pass; +}; +if ($@) { + fail $@; +} + +# (2) Build template from file +my $template = Text::Template->new('type' => 'FILE', 'source' => $TEMPFILE); +ok(defined $template) or diag $Text::Template::ERROR; + +# (3) Fill in template from file +$X::v = "abc"; +my $resultX = <<EOM; +We will put value of \$v (which is "abc") here -> abc +We will evaluate 1+1 here -> 2 +EOM +$Y::v = "ABC"; +my $resultY = <<EOM; +We will put value of \$v (which is "abc") here -> ABC +We will evaluate 1+1 here -> 2 +EOM + +my $text = $template->fill_in('package' => 'X'); +is $text, $resultX; + +# (4) Fill in same template again +$text = $template->fill_in('package' => 'Y'); +is $text, $resultY; + +# (5) Simple test of `fill_this_in' +$text = Text::Template->fill_this_in($template_1, 'package' => 'X'); +is $text, $resultX; + +# (6) test creation of template from filehandle +open my $tmpl, '<', $TEMPFILE or die "failed to open $TEMPFILE: $!"; + +$template = Text::Template->new(type => 'FILEHANDLE', source => $tmpl); +ok defined $template or diag $Text::Template::ERROR; + +# (7) test filling in of template from filehandle +$text = $template->fill_in('package' => 'X'); +is $text, $resultX; + +# (8) test second fill_in on same template object +$text = $template->fill_in('package' => 'Y'); +is $text, $resultY; + +close $tmpl; + +# (9) test creation of template from array +$template = Text::Template->new( + type => 'ARRAY', + source => [ + 'We will put value of $v (which is "abc") here -> {$v}', "\n", + 'We will evaluate 1+1 here -> {1+1}', "\n" + ] +); + +ok defined $template; # or diag $Text::Template::ERROR; + +# (10) test filling in of template from array +$text = $template->fill_in('package' => 'X'); +is $text, $resultX; + +# (11) test second fill_in on same array template object +$text = $template->fill_in('package' => 'Y'); +is $text, $resultY; + +# (12) Make sure \ is working properly +# Test added for version 1.11 +$tmpl = Text::Template->new(TYPE => 'STRING', SOURCE => 'B{"\\}"}C{"\\{"}D'); + +# This should fail if the \ are not interpreted properly. +$text = $tmpl->fill_in(); +is $text, 'B}C{D'; + +# (13) Make sure \ is working properly +# Test added for version 1.11 +$tmpl = Text::Template->new(TYPE => 'STRING', SOURCE => qq{A{"\t"}B}); + +# Symptom of old problem: ALL \ were special in templates, so +# The lexer would return (A, PROGTEXT("t"), B), and the +# result text would be AtB instead of A(tab)B. +$text = $tmpl->fill_in(); + +is $text, "A\tB"; + +# (14-27) Make sure \ is working properly +# Test added for version 1.11 +# This is a sort of general test. +my @tests = ( + '{""}' => '', # (14) + '{"}"}' => undef, # (15) + '{"\\}"}' => '}', # One backslash + '{"\\\\}"}' => undef, # Two backslashes + '{"\\\\\\}"}' => '}', # Three backslashes + '{"\\\\\\\\}"}' => undef, # Four backslashes + '{"\\\\\\\\\\}"}' => '\}', # Five backslashes (20) + '{"x20"}' => 'x20', + '{"\\x20"}' => ' ', # One backslash + '{"\\\\x20"}' => '\\x20', # Two backslashes + '{"\\\\\\x20"}' => '\\ ', # Three backslashes + '{"\\\\\\\\x20"}' => '\\\\x20', # Four backslashes (25) + '{"\\\\\\\\\\x20"}' => '\\\\ ', # Five backslashes + '{"\\x20\\}"}' => ' }', # (27) +); + +while (my ($test, $result) = splice @tests, 0, 2) { + my $tmpl = Text::Template->new(TYPE => 'STRING', SOURCE => $test); + my $text = $tmpl->fill_in; + + ok(!defined $text && !defined $result || $text eq $result) + or diag "expected .$result. got .$text."; +} + +# (28-30) I discovered that you can't pass a glob ref as your filehandle. +# MJD 20010827 +# (28) test creation of template from filehandle +$tmpl = undef; +ok(open $tmpl, '<', $TEMPFILE) or diag "Couldn't open $TEMPFILE: $!"; +$template = Text::Template->new(type => 'FILEHANDLE', source => $tmpl); +ok(defined $template) or diag $Text::Template::ERROR; + +# (29) test filling in of template from filehandle +$text = $template->fill_in('package' => 'X'); +is $text, $resultX; + +# (30) test second fill_in on same template object +$text = $template->fill_in('package' => 'Y'); +is $text, $resultY; + +close $tmpl; + +# (31) Test _scrubpkg for leakiness +$Text::Template::GEN0::test = 1; +Text::Template::_scrubpkg('Text::Template::GEN0'); +ok !($Text::Template::GEN0::test + || exists $Text::Template::GEN0::{test} + || exists $Text::Template::{'GEN0::'}); + +# that filename parameter works. we use BROKEN to verify this +$text = Text::Template->new( + TYPE => 'string', + SOURCE => 'Hello {1/0}' +)->fill_in(FILENAME => 'foo.txt'); + +like $text, qr/division by zero at foo\.txt line 1/; diff --git a/external/perl/Text-Template-1.56/t/broken.t b/external/perl/Text-Template-1.56/t/broken.t new file mode 100755 index 000000000000..40e7b7465029 --- /dev/null +++ b/external/perl/Text-Template-1.56/t/broken.t @@ -0,0 +1,66 @@ +#!perl +# test apparatus for Text::Template module + +use strict; +use warnings; +use Test::More tests => 7; + +use_ok 'Text::Template' or exit 1; + +# (1) basic error delivery +{ + my $r = Text::Template->new( + TYPE => 'string', + SOURCE => '{1/0}',)->fill_in(); + is $r, q{Program fragment delivered error ``Illegal division by zero at template line 1.''}; +} + +# (2) BROKEN sub called in ->new? +{ + my $r = Text::Template->new( + TYPE => 'string', + SOURCE => '{1/0}', + BROKEN => sub { '---' },)->fill_in(); + is $r, q{---}; +} + +# (3) BROKEN sub called in ->fill_in? +{ + my $r = Text::Template->new( + TYPE => 'string', + SOURCE => '{1/0}',)->fill_in(BROKEN => sub { '---' }); + is $r, q{---}; +} + +# (4) BROKEN sub passed correct args when called in ->new? +{ + my $r = Text::Template->new( + TYPE => 'string', + SOURCE => '{1/0}', + BROKEN => sub { + my %a = @_; + qq{$a{lineno},$a{error},$a{text}}; + },)->fill_in(); + is $r, qq{1,Illegal division by zero at template line 1.\n,1/0}; +} + +# (5) BROKEN sub passed correct args when called in ->fill_in? +{ + my $r = Text::Template->new( + TYPE => 'string', + SOURCE => '{1/0}', + )->fill_in( + BROKEN => sub { + my %a = @_; + qq{$a{lineno},$a{error},$a{text}}; + }); + is $r, qq{1,Illegal division by zero at template line 1.\n,1/0}; +} + +# BROKEN sub handles undef +{ + my $r = Text::Template->new(TYPE => 'string', SOURCE => 'abc{1/0}defg') + ->fill_in(BROKEN => sub { undef }); + + is $r, 'abc'; +} diff --git a/external/perl/Text-Template-1.56/t/delimiters.t b/external/perl/Text-Template-1.56/t/delimiters.t new file mode 100755 index 000000000000..f7185c693ba2 --- /dev/null +++ b/external/perl/Text-Template-1.56/t/delimiters.t @@ -0,0 +1,83 @@ +#!perl +# +# Tests for user-specified delimiter functions +# These tests first appeared in version 1.20. + +use strict; +use warnings; +use Test::More tests => 19; + +use_ok 'Text::Template' or exit 1; + +# (1) Try a simple delimiter: <<..>> +# First with the delimiters specified at object creation time +our $V = $V = 119; +my $template = q{The value of $V is <<$V>>.}; +my $result = q{The value of $V is 119.}; +my $template1 = Text::Template->new( + TYPE => 'STRING', + SOURCE => $template, + DELIMITERS => [ '<<', '>>' ]) + or die "Couldn't construct template object: $Text::Template::ERROR; aborting"; + +my $text = $template1->fill_in(); +is $text, $result; + +# (2) Now with delimiter choice deferred until fill-in time. +$template1 = Text::Template->new(TYPE => 'STRING', SOURCE => $template); +$text = $template1->fill_in(DELIMITERS => [ '<<', '>>' ]); +is $text, $result; + +# (3) Now we'll try using regex metacharacters +# First with the delimiters specified at object creation time +$template = q{The value of $V is [$V].}; +$template1 = Text::Template->new( + TYPE => 'STRING', + SOURCE => $template, + DELIMITERS => [ '[', ']' ]) + or die "Couldn't construct template object: $Text::Template::ERROR; aborting"; + +$text = $template1->fill_in(); +is $text, $result; + +# (4) Now with delimiter choice deferred until fill-in time. +$template1 = Text::Template->new(TYPE => 'STRING', SOURCE => $template); +$text = $template1->fill_in(DELIMITERS => [ '[', ']' ]); +is $text, $result; + +# (5-18) Make sure \ is working properly +# (That is to say, it is ignored.) +# These tests are similar to those in 01-basic.t. +my @tests = ( + '{""}' => '', # (5) + + # Backslashes don't matter + '{"}"}' => undef, + '{"\\}"}' => undef, # One backslash + '{"\\\\}"}' => undef, # Two backslashes + '{"\\\\\\}"}' => undef, # Three backslashes + '{"\\\\\\\\}"}' => undef, # Four backslashes (10) + '{"\\\\\\\\\\}"}' => undef, # Five backslashes + + # Backslashes are always passed directly to Perl + '{"x20"}' => 'x20', + '{"\\x20"}' => ' ', # One backslash + '{"\\\\x20"}' => '\\x20', # Two backslashes + '{"\\\\\\x20"}' => '\\ ', # Three backslashes (15) + '{"\\\\\\\\x20"}' => '\\\\x20', # Four backslashes + '{"\\\\\\\\\\x20"}' => '\\\\ ', # Five backslashes + '{"\\x20\\}"}' => undef, # (18) +); + +while (my ($test, $result) = splice @tests, 0, 2) { + my $tmpl = Text::Template->new( + TYPE => 'STRING', + SOURCE => $test, + DELIMITERS => [ '{', '}' ]); + + my $text = $tmpl->fill_in; + + my $ok = (!defined $text && !defined $result || $text eq $result); + + ok($ok) or diag "expected .$result., got .$text."; +} diff --git a/external/perl/Text-Template-1.56/t/error.t b/external/perl/Text-Template-1.56/t/error.t new file mode 100755 index 000000000000..4f024db12378 --- /dev/null +++ b/external/perl/Text-Template-1.56/t/error.t @@ -0,0 +1,34 @@ +#!perl +# +# test apparatus for Text::Template module +# still incomplete. + +use strict; +use warnings; +use Test::More tests => 6; + +use_ok 'Text::Template' or exit 1; + +# (1-2) Missing source +eval { + Text::Template->new(); + pass; +}; + +like $@, qr/^\QUsage: Text::Template::new(TYPE => ..., SOURCE => ...)/; + +eval { Text::Template->new(TYPE => 'FILE'); }; +like $@, qr/^\QUsage: Text::Template::new(TYPE => ..., SOURCE => ...)/; + +# (3) Invalid type +eval { Text::Template->new(TYPE => 'wlunch', SOURCE => 'fish food'); }; +like $@, qr/^\QIllegal value `WLUNCH' for TYPE parameter/; + +# (4-5) File does not exist +my $o = Text::Template->new( + TYPE => 'file', + SOURCE => 'this file does not exist'); +ok !defined $o; + +ok defined($Text::Template::ERROR) + && $Text::Template::ERROR =~ /^Couldn't open file/; diff --git a/external/perl/Text-Template-1.56/t/exported.t b/external/perl/Text-Template-1.56/t/exported.t new file mode 100755 index 000000000000..ab2adcd4a806 --- /dev/null +++ b/external/perl/Text-Template-1.56/t/exported.t @@ -0,0 +1,68 @@ +#!perl +# +# test apparatus for Text::Template module +# still incomplete. + +use strict; +use warnings; +use Test::More tests => 7; +use File::Temp; + +use_ok 'Text::Template' or exit 1; + +my $tfh = File::Temp->new; + +Text::Template->import('fill_in_file', 'fill_in_string'); + +$Q::n = $Q::n = 119; + +# (1) Test fill_in_string +my $out = fill_in_string('The value of $n is {$n}.', PACKAGE => 'Q'); +is $out, 'The value of $n is 119.'; + +# (2) Test fill_in_file +my $TEMPFILE = $tfh->filename; + +print $tfh 'The value of $n is {$n}.', "\n"; +close $tfh or die "Couldn't write test file: $!; aborting"; + +$R::n = $R::n = 8128; + +$out = fill_in_file($TEMPFILE, PACKAGE => 'R'); +is $out, "The value of \$n is 8128.\n"; + +# (3) Jonathan Roy reported this bug: +open my $ofh, '>', $TEMPFILE or die "Couldn't open test file: $!; aborting"; +print $ofh "With a message here? [% \$var %]\n"; +close $ofh or die "Couldn't close test file: $!; aborting"; +$out = fill_in_file($TEMPFILE, + DELIMITERS => [ '[%', '%]' ], + HASH => { "var" => \"It is good!" }); +is $out, "With a message here? It is good!\n"; + +# (4) It probably occurs in fill_this_in also: +$out = Text::Template->fill_this_in("With a message here? [% \$var %]\n", + DELIMITERS => [ '[%', '%]' ], + HASH => { "var" => \"It is good!" }); +is $out, "With a message here? It is good!\n"; + +# (5) This test failed in 1.25. It was supplied by Donald L. Greer Jr. +# Note that it's different from (1) in that there's no explicit +# package=> argument. +use vars qw($string $foo $r); +$string = 'Hello {$foo}'; +$foo = "Don"; +$r = fill_in_string($string); +is $r, 'Hello Don'; + +# (6) This test failed in 1.25. It's a variation on (5) +package Q2; +use Text::Template 'fill_in_string'; +use vars qw($string $foo $r); +$string = 'Hello {$foo}'; +$foo = "Don"; +$r = fill_in_string($string); + +package main; + +is $Q2::r, 'Hello Don'; diff --git a/external/perl/Text-Template-1.56/t/hash.t b/external/perl/Text-Template-1.56/t/hash.t new file mode 100755 index 000000000000..3d59f3366149 --- /dev/null +++ b/external/perl/Text-Template-1.56/t/hash.t @@ -0,0 +1,91 @@ +#!perl +# +# test apparatus for Text::Template module +# still incomplete. + +use strict; +use warnings; +use Test::More tests => 13; + +use_ok 'Text::Template' or exit 1; + +my $template = 'We will put value of $v (which is "good") here -> {$v}'; + +my $v = 'oops (main)'; +$Q::v = 'oops (Q)'; + +my $vars = { 'v' => \'good' }; + +# (1) Build template from string +$template = Text::Template->new('type' => 'STRING', 'source' => $template); +isa_ok $template, 'Text::Template'; + +# (2) Fill in template in anonymous package +my $result2 = 'We will put value of $v (which is "good") here -> good'; +my $text = $template->fill_in(HASH => $vars); +is $text, $result2; + +# (3) Did we clobber the main variable? +is $v, 'oops (main)'; + +# (4) Fill in same template again +my $result4 = 'We will put value of $v (which is "good") here -> good'; +$text = $template->fill_in(HASH => $vars); +is $text, $result4; + +# (5) Now with a package +my $result5 = 'We will put value of $v (which is "good") here -> good'; +$text = $template->fill_in(HASH => $vars, PACKAGE => 'Q'); +is $text, $result5; + +# (6) We expect to have clobbered the Q variable. +is $Q::v, 'good'; + +# (7) Now let's try it without a package +my $result7 = 'We will put value of $v (which is "good") here -> good'; +$text = $template->fill_in(HASH => $vars); +is $text, $result7; + +# (8-11) Now what does it do when we pass a hash with undefined values? +# Roy says it does something bad. (Added for 1.20.) +my $WARNINGS = 0; +{ + local $SIG{__WARN__} = sub { $WARNINGS++ }; + local $^W = 1; # Make sure this is on for this test + my $template8 = 'We will put value of $v (which is "good") here -> {defined $v ? "bad" : "good"}'; + my $result8 = 'We will put value of $v (which is "good") here -> good'; + my $template = Text::Template->new('type' => 'STRING', 'source' => $template8); + my $text = $template->fill_in(HASH => { 'v' => undef }); + + # (8) Did we generate a warning? + cmp_ok $WARNINGS, '==', 0; + + # (9) Was the output correct? + is $text, $result8; + + # (10-11) Let's try that again, with a twist this time + $WARNINGS = 0; + $text = $template->fill_in(HASH => [ { 'v' => 17 }, { 'v' => undef } ]); + + # (10) Did we generate a warning? + cmp_ok $WARNINGS, '==', 0; + + # (11) Was the output correct? + SKIP: { + skip 'not supported before 5.005', 1 unless $] >= 5.005; + + is $text, $result8; + } +} + +# (12) Now we'll test the multiple-hash option (Added for 1.20.) +$text = Text::Template::fill_in_string(q{$v: {$v}. @v: [{"@v"}].}, + HASH => [ + { 'v' => 17 }, + { 'v' => [ 'a', 'b', 'c' ] }, + { 'v' => \23 } + ] +); + +my $result = q{$v: 23. @v: [a b c].}; +is $text, $result; diff --git a/external/perl/Text-Template-1.56/t/inline-comment.t b/external/perl/Text-Template-1.56/t/inline-comment.t new file mode 100755 index 000000000000..bf7a227a515e --- /dev/null +++ b/external/perl/Text-Template-1.56/t/inline-comment.t @@ -0,0 +1,17 @@ +#!perl +# +# Test for comments within an inline code block + +use strict; +use warnings; +use Test::More tests => 2; + +use_ok 'Text::Template' or exit 1; + +my $tmpl = Text::Template->new( + TYPE => 'STRING', + SOURCE => "Hello {\$name#comment}"); + +my $vars = { name => 'Bob' }; + +is $tmpl->fill_in(HASH => $vars), 'Hello Bob'; diff --git a/external/perl/Text-Template-1.56/t/nested-tags.t b/external/perl/Text-Template-1.56/t/nested-tags.t new file mode 100755 index 000000000000..79bf6a1ae2f3 --- /dev/null +++ b/external/perl/Text-Template-1.56/t/nested-tags.t @@ -0,0 +1,26 @@ +#!perl +# +# Test for breakage of Dist::Milla in v1.46 +# + +use strict; +use warnings; +use Text::Template; + +BEGIN { + # Minimum Test::More version; 0.94+ is required for `done_testing` + unless (eval { require Test::More; "$Test::More::VERSION" >= 0.94; }) { + Test::More::plan(skip_all => '[ Test::More v0.94+ ] is required for testing'); + } + + Test::More->import; +} + +my $tmpl = Text::Template->new( + TYPE => 'STRING', + SOURCE => q| {{ '{{$NEXT}}' }} |, + DELIMITERS => [ '{{', '}}' ]); + +is $tmpl->fill_in, ' {{$NEXT}} '; + +done_testing; diff --git a/external/perl/Text-Template-1.56/t/ofh.t b/external/perl/Text-Template-1.56/t/ofh.t new file mode 100755 index 000000000000..a490e7abe551 --- /dev/null +++ b/external/perl/Text-Template-1.56/t/ofh.t @@ -0,0 +1,33 @@ +#!perl +# +# test apparatus for Text::Template module +# still incomplete. + +use strict; +use warnings; +use Test::More tests => 3; +use File::Temp; + +use_ok 'Text::Template' or exit 1; + +my $template = Text::Template->new( + TYPE => 'STRING', + SOURCE => q{My process ID is {$$}}); + +my $of = File::Temp->new; + +my $text = $template->fill_in(OUTPUT => $of); + +# (1) No $text should have been constructed. Return value should be true. +is $text, '1'; + +close $of or die "close(): $!"; + +open my $ifh, '<', $of->filename or die "open($of): $!"; + +my $t; +{ local $/; $t = <$ifh> } +close $ifh; + +# (2) The text should have been printed to the file +is $t, "My process ID is $$"; diff --git a/external/perl/Text-Template-1.56/t/out.t b/external/perl/Text-Template-1.56/t/out.t new file mode 100755 index 000000000000..a805c7108993 --- /dev/null +++ b/external/perl/Text-Template-1.56/t/out.t @@ -0,0 +1,46 @@ +#!perl +# +# test apparatus for Text::Template module +# still incomplete. +# + +use strict; +use warnings; +use Test::More tests => 4; + +use_ok 'Text::Template' or exit 1; + +my $templateIN = q{ +This line should have a 3: {1+2} + +This line should have several numbers: +{ $t = ''; foreach $n (1 .. 20) { $t .= $n . ' ' } $t } +}; + +my $templateOUT = q{ +This line should have a 3: { $OUT = 1+2 } + +This line should have several numbers: +{ foreach $n (1 .. 20) { $OUT .= $n . ' ' } } +}; + +# Build templates from string +my $template = Text::Template->new('type' => 'STRING', 'source' => $templateIN); +isa_ok $template, 'Text::Template'; + +$templateOUT = Text::Template->new('type' => 'STRING', 'source' => $templateOUT); +isa_ok $templateOUT, 'Text::Template'; + +# Fill in templates +my $text = $template->fill_in(); +my $textOUT = $templateOUT->fill_in(); + +# (1) They should be the same +is $text, $textOUT; + +# Missing: Test this feature in Safe compartments; +# it's a totally different code path. +# Decision: Put that into safe.t, because that file should +# be skipped when Safe.pm is unavailable. + +exit; diff --git a/external/perl/Text-Template-1.56/t/prepend.t b/external/perl/Text-Template-1.56/t/prepend.t new file mode 100755 index 000000000000..cbe205e004d3 --- /dev/null +++ b/external/perl/Text-Template-1.56/t/prepend.t @@ -0,0 +1,78 @@ +#!perl +# +# Tests for PREPEND features +# These tests first appeared in version 1.22. + +use strict; +use warnings; +use Test::More tests => 10; + +use_ok 'Text::Template' or exit 1; + +@Emptyclass1::ISA = 'Text::Template'; +@Emptyclass2::ISA = 'Text::Template'; + +my $tin = q{The value of $foo is: {$foo}}; + +Text::Template->always_prepend(q{$foo = "global"}); + +my $tmpl1 = Text::Template->new( + TYPE => 'STRING', + SOURCE => $tin); + +my $tmpl2 = Text::Template->new( + TYPE => 'STRING', + SOURCE => $tin, + PREPEND => q{$foo = "template"}); + +$tmpl1->compile; +$tmpl2->compile; + +my $t1 = $tmpl1->fill_in(PACKAGE => 'T1'); +my $t2 = $tmpl2->fill_in(PACKAGE => 'T2'); +my $t3 = $tmpl2->fill_in(PREPEND => q{$foo = "fillin"}, PACKAGE => 'T3'); + +is $t1, 'The value of $foo is: global'; +is $t2, 'The value of $foo is: template'; +is $t3, 'The value of $foo is: fillin'; + +Emptyclass1->always_prepend(q{$foo = 'Emptyclass global';}); +$tmpl1 = Emptyclass1->new( + TYPE => 'STRING', + SOURCE => $tin); + +$tmpl2 = Emptyclass1->new( + TYPE => 'STRING', + SOURCE => $tin, + PREPEND => q{$foo = "template"}); + +$tmpl1->compile; +$tmpl2->compile; + +$t1 = $tmpl1->fill_in(PACKAGE => 'T4'); +$t2 = $tmpl2->fill_in(PACKAGE => 'T5'); +$t3 = $tmpl2->fill_in(PREPEND => q{$foo = "fillin"}, PACKAGE => 'T6'); + +is $t1, 'The value of $foo is: Emptyclass global'; +is $t2, 'The value of $foo is: template'; +is $t3, 'The value of $foo is: fillin'; + +$tmpl1 = Emptyclass2->new( + TYPE => 'STRING', + SOURCE => $tin); + +$tmpl2 = Emptyclass2->new( + TYPE => 'STRING', + SOURCE => $tin, + PREPEND => q{$foo = "template"}); + +$tmpl1->compile; +$tmpl2->compile; + +$t1 = $tmpl1->fill_in(PACKAGE => 'T4'); +$t2 = $tmpl2->fill_in(PACKAGE => 'T5'); +$t3 = $tmpl2->fill_in(PREPEND => q{$foo = "fillin"}, PACKAGE => 'T6'); + +is $t1, 'The value of $foo is: global'; +is $t2, 'The value of $foo is: template'; +is $t3, 'The value of $foo is: fillin'; diff --git a/external/perl/Text-Template-1.56/t/preprocess.t b/external/perl/Text-Template-1.56/t/preprocess.t new file mode 100755 index 000000000000..a5faa96e1979 --- /dev/null +++ b/external/perl/Text-Template-1.56/t/preprocess.t @@ -0,0 +1,43 @@ +#!perl +# +# Tests for PREPROCESSOR features +# These tests first appeared in version 1.25. + +use strict; +use warnings; +use Test::More tests => 9; +use File::Temp; + +use_ok 'Text::Template::Preprocess' or exit 1; + +my $tmpfile = File::Temp->new; +my $TMPFILE = $tmpfile->filename; + +my $py = sub { tr/x/y/ }; +my $pz = sub { tr/x/z/ }; + +my $t = 'xxx The value of $x is {$x}'; +my $outx = 'xxx The value of $x is 119'; +my $outy = 'yyy The value of $y is 23'; +my $outz = 'zzz The value of $z is 5'; +open my $tfh, '>', $TMPFILE or die "Couldn't open test file: $!; aborting"; +print $tfh $t; +close $tfh; + +my @result = ($outx, $outy, $outz, $outz); +for my $trial (1, 0) { + for my $test (0 .. 3) { + my $tmpl; + if ($trial == 0) { + $tmpl = Text::Template::Preprocess->new(TYPE => 'STRING', SOURCE => $t) or die; + } + else { + open $tfh, '<', $TMPFILE or die "Couldn't open test file: $!; aborting"; + $tmpl = Text::Template::Preprocess->new(TYPE => 'FILEHANDLE', SOURCE => $tfh) or die; + } + $tmpl->preprocessor($py) if ($test & 1) == 1; + my @args = ((($test & 2) == 2) ? (PREPROCESSOR => $pz) : ()); + my $o = $tmpl->fill_in(@args, HASH => { x => 119, 'y' => 23, z => 5 }); + is $o, $result[$test]; + } +} diff --git a/external/perl/Text-Template-1.56/t/rt29928.t b/external/perl/Text-Template-1.56/t/rt29928.t new file mode 100755 index 000000000000..b50d53ad428f --- /dev/null +++ b/external/perl/Text-Template-1.56/t/rt29928.t @@ -0,0 +1,26 @@ +#!perl +# +# Test for RT Bug 29928 fix +# https://rt.cpan.org/Public/Bug/Display.html?id=29928 + +use strict; +use warnings; +use Test::More tests => 2; + +use_ok 'Text::Template::Preprocess' or exit 1; + +my $tin = q{The value of $foo is: {$foo}.}; + +sub tester { + 1; # dummy preprocessor to cause the bug described. +} + +my $tmpl1 = Text::Template::Preprocess->new(TYPE => 'STRING', SOURCE => $tin); + +$tmpl1->compile; + +my $t1 = $tmpl1->fill_in( + HASH => { foo => 'things' }, + PREPROCESSOR => \&tester); + +is $t1, 'The value of $foo is: things.'; diff --git a/external/perl/Text-Template-1.56/t/safe.t b/external/perl/Text-Template-1.56/t/safe.t new file mode 100755 index 000000000000..762aba871f31 --- /dev/null +++ b/external/perl/Text-Template-1.56/t/safe.t @@ -0,0 +1,135 @@ +#!perl +# +# test apparatus for Text::Template module +# still incomplete. + +use strict; +use warnings; + +use Test::More; + +unless (eval { require Safe; 1 }) { + plan skip_all => 'Safe.pm is required for this test'; +} +else { + plan tests => 20; +} + +use_ok 'Text::Template' or exit 1; + +my ($BADOP, $FAILURE); +if ($^O eq 'MacOS') { + $BADOP = qq{}; + $FAILURE = q{}; +} +else { + $BADOP = qq{kill 0}; + $FAILURE = q{Program fragment at line 1 delivered error ``kill trapped by operation mask''}; +} + +our $v = 119; + +my $c = Safe->new or die; + +my $goodtemplate = q{This should succeed: { $v }}; +my $goodoutput = q{This should succeed: 119}; + +my $template1 = Text::Template->new(type => 'STRING', source => $goodtemplate); +my $template2 = Text::Template->new(type => 'STRING', source => $goodtemplate); + +my $text1 = $template1->fill_in(); +ok defined $text1; + +my $text2 = $template1->fill_in(SAFE => $c); +ok defined $text2; + +my $text3 = $template2->fill_in(SAFE => $c); +ok defined $text3; + +# (4) Safe and non-safe fills of different template objects with the +# same template text should yield the same result. +# print +($text1 eq $text3 ? '' : 'not '), "ok $n\n"; +# (4) voided this test: it's not true, because the unsafe fill +# uses package main, while the safe fill uses the secret safe package. +# We could alias the secret safe package to be identical to main, +# but that wouldn't be safe. If you want the aliasing, you have to +# request it explicitly with `PACKAGE'. + +# (5) Safe and non-safe fills of the same template object +# should yield the same result. +# (5) voided this test for the same reason as #4. +# print +($text1 eq $text2 ? '' : 'not '), "ok $n\n"; + +# (6) Make sure the output was actually correct +is $text1, $goodoutput; + +my $badtemplate = qq{This should fail: { $BADOP; 'NOFAIL' }}; +my $badnosafeoutput = q{This should fail: NOFAIL}; +my $badsafeoutput = + q{This should fail: Program fragment delivered error ``kill trapped by operation mask at template line 1.''}; + +$template1 = Text::Template->new('type' => 'STRING', 'source' => $badtemplate); +isa_ok $template1, 'Text::Template'; + +$template2 = Text::Template->new('type' => 'STRING', 'source' => $badtemplate); +isa_ok $template2, 'Text::Template'; + +# none of these should fail +$text1 = $template1->fill_in(); +ok defined $text1; + +$text2 = $template1->fill_in(SAFE => $c); +ok defined $text2; + +$text3 = $template2->fill_in(SAFE => $c); +ok defined $text3; + +my $text4 = $template1->fill_in(); +ok defined $text4; + +# (11) text1 and text4 should be the same (using safe in between +# didn't change anything.) +is $text1, $text4; + +# (12) text2 and text3 should be the same (same template text in different +# objects +is $text2, $text3; + +# (13) text1 should yield badnosafeoutput +is $text1, $badnosafeoutput; + +# (14) text2 should yield badsafeoutput +$text2 =~ s/'kill'/kill/; # 5.8.1 added quote marks around the op name +is $text2, $badsafeoutput; + +my $template = q{{$x=1}{$x+1}}; + +$template1 = Text::Template->new('type' => 'STRING', 'source' => $template); +isa_ok $template1, 'Text::Template'; + +$template2 = Text::Template->new('type' => 'STRING', 'source' => $template); +isa_ok $template2, 'Text::Template'; + +$text1 = $template1->fill_in(); +$text2 = $template1->fill_in(SAFE => Safe->new); + +# (15) Do effects persist in safe compartments? +is $text1, $text2; + +# (16) Try the BROKEN routine in safe compartments +sub my_broken { + my %a = @_; + $a{error} =~ s/ at.*//s; + "OK! text:$a{text} error:$a{error} lineno:$a{lineno} arg:$a{arg}"; +} + +my $templateB = Text::Template->new(TYPE => 'STRING', SOURCE => '{die}'); +isa_ok $templateB, 'Text::Template'; + +$text1 = $templateB->fill_in( + BROKEN => \&my_broken, + BROKEN_ARG => 'barg', + SAFE => Safe->new); + +my $result1 = qq{OK! text:die error:Died lineno:1 arg:barg}; +is $text1, $result1; diff --git a/external/perl/Text-Template-1.56/t/safe2.t b/external/perl/Text-Template-1.56/t/safe2.t new file mode 100755 index 000000000000..cfb997bc7982 --- /dev/null +++ b/external/perl/Text-Template-1.56/t/safe2.t @@ -0,0 +1,94 @@ +#!perl +# +# test apparatus for Text::Template module +# still incomplete. + +use strict; +use warnings; +use Test::More; + +unless (eval { require Safe; 1 }) { + plan skip_all => 'Safe.pm is required for this test'; +} +else { + plan tests => 12; +} + +use_ok 'Text::Template' or exit 1; + +my $c = Safe->new or die; + +# Test handling of packages and importing. +$c->reval('$P = "safe root"'); +our $P = 'main'; +$Q::P = $Q::P = 'Q'; + +# How to effectively test the gensymming? + +my $t = Text::Template->new( + TYPE => 'STRING', + SOURCE => 'package is {$P}') or die; + +# (1) Default behavior: Inherit from calling package, `main' in this case. +my $text = $t->fill_in(); +is $text, 'package is main'; + +# (2) When a package is specified, we should use that package instead. +$text = $t->fill_in(PACKAGE => 'Q'); +is $text, 'package is Q'; + +# (3) When no package is specified in safe mode, we should use the +# default safe root. +$text = $t->fill_in(SAFE => $c); +is $text, 'package is safe root'; + +# (4) When a package is specified in safe mode, we should use the +# default safe root, after aliasing to the specified package +TODO: { + local $TODO = "test fails when tested with TAP/Devel::Cover" if defined $Devel::Cover::VERSION; + $text = $t->fill_in(SAFE => $c, PACKAGE => 'Q'); + is $text, 'package is Q'; +} + +# Now let's see if hash vars are installed properly into safe templates +$t = Text::Template->new( + TYPE => 'STRING', + SOURCE => 'hash is {$H}') or die; + +# (5) First in default mode +$text = $t->fill_in(HASH => { H => 'good5' }); +is $text, 'hash is good5'; + +# suppress "once" warnings +$Q::H = $Q2::H = undef; + +# (6) Now in packages +$text = $t->fill_in(HASH => { H => 'good6' }, PACKAGE => 'Q'); +is $text, 'hash is good6'; + +# (7) Now in the default root of the safe compartment +TODO: { + local $TODO = "test fails when tested with TAP/Devel::Cover" if defined $Devel::Cover::VERSION; + $text = $t->fill_in(HASH => { H => 'good7' }, SAFE => $c); + is $text, 'hash is good7'; +} + +# (8) Now in the default root after aliasing to a package that +# got the hash stuffed in +our $H; +TODO: { + local $TODO = "test fails when tested with TAP/Devel::Cover" if defined $Devel::Cover::VERSION; + $text = $t->fill_in(HASH => { H => 'good8' }, SAFE => $c, PACKAGE => 'Q2'); + is $text, 'hash is good8'; +} + +# Now let's make sure that none of the packages leaked on each other. +# (9) This var should NOT have been installed into the main package +ok !defined $H; +$H = $H; + +# (11) this value overwrote the one from test 6. +is $Q::H, 'good7'; + +# (12) +is $Q2::H, 'good8'; diff --git a/external/perl/Text-Template-1.56/t/safe3.t b/external/perl/Text-Template-1.56/t/safe3.t new file mode 100755 index 000000000000..445c60d99267 --- /dev/null +++ b/external/perl/Text-Template-1.56/t/safe3.t @@ -0,0 +1,80 @@ +#!perl +# +# test apparatus for Text::Template module + +use strict; +use warnings; +use Test::More; + +unless (eval { require Safe; 1 }) { + plan skip_all => 'Safe.pm is required for this test'; +} +else { + plan tests => 4; +} + +use_ok 'Text::Template' or exit 1; + +# Test the OUT feature with safe compartments + +my $template = q{ +This line should have a 3: {1+2} + +This line should have several numbers: +{ $t = ''; foreach $n (1 .. 20) { $t .= $n . ' ' } $t } +}; + +my $templateOUT = q{ +This line should have a 3: { $OUT = 1+2 } + +This line should have several numbers: +{ foreach $n (1 .. 20) { $OUT .= $n . ' ' } } +}; + +my $c = Safe->new; + +# Build templates from string +$template = Text::Template->new( + type => 'STRING', + source => $template, + SAFE => $c) or die; + +$templateOUT = Text::Template->new( + type => 'STRING', + source => $templateOUT, + SAFE => $c) or die; + +# Fill in templates +my $text = $template->fill_in() + or die; +my $textOUT = $templateOUT->fill_in() + or die; + +# (1) They should be the same +is $text, $textOUT; + +# (2-3) "Joel Appelbaum" <joel@orbz.com> <000701c0ac2c$aed1d6e0$0201a8c0@prime> +# "Contrary to the documentation the $OUT variable is not always +# undefined at the start of each program fragment. The $OUT variable +# is never undefined after it is used once if you are using the SAFE +# option. The result is that every fragment after the fragment that +# $OUT was used in is replaced by the old $OUT value instead of the +# result of the fragment. This holds true even after the +# Text::Template object goes out of scope and a new one is created!" +# +# Also reported by Daini Xie. + +{ + my $template = q{{$OUT = 'x'}y{$OUT .= 'z'}}; + my $expected = "xyz"; + my $s = Safe->new; + my $o = Text::Template->new( + type => 'string', + source => $template); + + for (1 .. 2) { + my $r = $o->fill_in(SAFE => $s); + + is $r, $expected; + } +} diff --git a/external/perl/Text-Template-1.56/t/strict.t b/external/perl/Text-Template-1.56/t/strict.t new file mode 100755 index 000000000000..f56aa586c5dd --- /dev/null +++ b/external/perl/Text-Template-1.56/t/strict.t @@ -0,0 +1,46 @@ +#!perl +# +# Tests for STRICT features +# These tests first appeared in version 1.48. + +use strict; +use warnings; +use Test::More tests => 4; + +use_ok 'Text::Template' or exit 1; + +@Emptyclass1::ISA = 'Text::Template'; +@Emptyclass2::ISA = 'Text::Template'; + +my $tin = q{The value of $foo is: {$foo}}; + +Text::Template->always_prepend(q{$foo = "global"}); + +my $tmpl1 = Text::Template->new( + TYPE => 'STRING', + SOURCE => $tin); + +my $tmpl2 = Text::Template->new( + TYPE => 'STRING', + SOURCE => $tin, + PREPEND => q{$foo = "template"}); + +$tmpl1->compile; +$tmpl2->compile; + +# strict should cause t1 to contain an error message if wrong variable is used in template +my $t1 = $tmpl1->fill_in(PACKAGE => 'T1', STRICT => 1, HASH => { bar => 'baz' }); + +# non-strict still works +my $t2 = $tmpl2->fill_in(PACKAGE => 'T2', HASH => { bar => 'baz' }); + +# prepend overrides the hash values +my $t3 = $tmpl2->fill_in( + PREPEND => q{$foo = "fillin"}, + PACKAGE => 'T3', + STRICT => 1, + HASH => { foo => 'hashval2' }); + +like $t1, qr/Global symbol "\$foo" requires explicit package/; +is $t2, 'The value of $foo is: template', "non-strict hash still works"; +is $t3, "The value of \$foo is: fillin", "hash values with prepend, prepend wins, even under strict."; diff --git a/external/perl/Text-Template-1.56/t/taint.t b/external/perl/Text-Template-1.56/t/taint.t new file mode 100755 index 000000000000..94cd26bf7d66 --- /dev/null +++ b/external/perl/Text-Template-1.56/t/taint.t @@ -0,0 +1,112 @@ +#!perl -T +# Tests for taint-mode features + +use strict; +use warnings; +use lib 'blib/lib'; +use Test::More tests => 21; +use File::Temp; + +use_ok 'Text::Template' or exit 1; + +if ($^O eq 'MSWin32') { + # File::Temp (for all versions up to at least 0.2308) is currently bugged under MSWin32/taint mode [as of 2018-09] + # ... fails unless "/tmp" on the current windows drive is a writable directory OR either $ENV{TMP} or $ENV{TEMP} are untainted and point to a writable directory + # ref: [File-Temp: Fails under -T, Windows 7, Strawberry Perl 5.12.1](https://rt.cpan.org/Public/Bug/Display.html?id=60340) + ($ENV{TEMP}) = $ENV{TEMP} =~ m/^.*$/gmsx; # untaint $ENV{TEMP} + ($ENV{TMP}) = $ENV{TMP} =~ m/^.*$/gmsx; # untaint $ENV{TMP} +} + +my $tmpfile = File::Temp->new; +my $file = $tmpfile->filename; + +# makes its arguments tainted +sub taint { + for (@_) { + $_ .= substr($0, 0, 0); # LOD + } +} + +my $template = 'The value of $n is {$n}.'; + +open my $fh, '>', $file or die "Couldn't write temporary file $file: $!"; +print $fh $template, "\n"; +close $fh or die "Couldn't finish temporary file $file: $!"; + +sub should_fail { + my $obj = Text::Template->new(@_); + eval { $obj->fill_in() }; + if ($@) { + pass $@; + } + else { + fail q[didn't fail]; + } +} + +sub should_work { + my $obj = Text::Template->new(@_); + eval { $obj->fill_in() }; + if ($@) { + fail $@; + } + else { + pass; + } +} + +sub should_be_tainted { + ok !Text::Template::_is_clean($_[0]); +} + +sub should_be_clean { + ok Text::Template::_is_clean($_[0]); +} + +# Tainted filename should die with and without UNTAINT option +# untainted filename should die without UNTAINT option +# filehandle should die without UNTAINT option +# string and array with tainted data should die either way + +# (2)-(7) +my $tfile = $file; +taint($tfile); +should_be_tainted($tfile); +should_be_clean($file); +should_fail TYPE => 'file', SOURCE => $tfile; +should_fail TYPE => 'file', SOURCE => $tfile, UNTAINT => 1; +should_fail TYPE => 'file', SOURCE => $file; +should_work TYPE => 'file', SOURCE => $file, UNTAINT => 1; + +# (8-9) +open $fh, '<', $file or die "Couldn't open $file for reading: $!; aborting"; +should_fail TYPE => 'filehandle', SOURCE => $fh; +close $fh; + +open $fh, '<', $file or die "Couldn't open $file for reading: $!; aborting"; +should_work TYPE => 'filehandle', SOURCE => $fh, UNTAINT => 1; +close $fh; + +# (10-15) +my $ttemplate = $template; +taint($ttemplate); +should_be_tainted($ttemplate); +should_be_clean($template); +should_fail TYPE => 'string', SOURCE => $ttemplate; +should_fail TYPE => 'string', SOURCE => $ttemplate, UNTAINT => 1; +should_work TYPE => 'string', SOURCE => $template; +should_work TYPE => 'string', SOURCE => $template, UNTAINT => 1; + +# (16-19) +my $array = [$template]; +my $tarray = [$ttemplate]; +should_fail TYPE => 'array', SOURCE => $tarray; +should_fail TYPE => 'array', SOURCE => $tarray, UNTAINT => 1; +should_work TYPE => 'array', SOURCE => $array; +should_work TYPE => 'array', SOURCE => $array, UNTAINT => 1; + +# (20-21) Test _unconditionally_untaint utility function +Text::Template::_unconditionally_untaint($ttemplate); +should_be_clean($ttemplate); +Text::Template::_unconditionally_untaint($tfile); +should_be_clean($tfile); diff --git a/external/perl/Text-Template-1.56/t/template-encoding.t b/external/perl/Text-Template-1.56/t/template-encoding.t new file mode 100755 index 000000000000..2dafe779fb02 --- /dev/null +++ b/external/perl/Text-Template-1.56/t/template-encoding.t @@ -0,0 +1,47 @@ +#!perl + +use utf8; +use strict; +use warnings; +use Test::More; +use Encode; +use File::Temp; + +# Non-CORE module(s) +unless (eval { require Test::More::UTF8; 1; } ) { + plan skip_all => '[ Test::More::UTF8 ] is required for testing'; +} + +plan tests => 3; + +use_ok 'Text::Template' or exit 1; + +my $tmp_fh = File::Temp->new; + +print $tmp_fh encode('UTF-8', "\x{4f60}\x{597d} {{\$name}}"); + +$tmp_fh->flush; + +# UTF-8 encoded template file +my $str = Text::Template->new( + TYPE => 'FILE', + SOURCE => $tmp_fh->filename, + ENCODING => 'UTF-8' +)->fill_in(HASH => { name => 'World' }); + +is $str, "\x{4f60}\x{597d} World"; + +$tmp_fh = File::Temp->new; + +print $tmp_fh encode('iso-8859-1', "Ol\x{e1} {{\$name}}"); + +$tmp_fh->flush; + +# ISO-8859-1 encoded template file +$str = Text::Template->new( + TYPE => 'FILE', + SOURCE => $tmp_fh->filename, + ENCODING => 'iso-8859-1' +)->fill_in(HASH => { name => 'World' }); + +is $str, "Ol\x{e1} World"; diff --git a/external/perl/Text-Template-1.56/t/warnings.t b/external/perl/Text-Template-1.56/t/warnings.t new file mode 100755 index 000000000000..a20a640b17d9 --- /dev/null +++ b/external/perl/Text-Template-1.56/t/warnings.t @@ -0,0 +1,46 @@ +#!perl + +use strict; +use warnings; +use Text::Template; + +# Minimum Test::More version; 0.94+ is required for `done_testing` +BEGIN { + unless (eval { require Test::More; "$Test::More::VERSION" >= 0.94; }) { + Test::More::plan(skip_all => '[ Test::More v0.94+ ] is required for testing'); + } + + Test::More->import; + + # Non-CORE module(s) + unless (eval { require Test::Warnings; 1; }) { + plan(skip_all => '[ Test::Warnings ] is required for testing'); + } + + Test::Warnings->import; +} + +my $template = <<'EOT'; +{{ +if ($good =~ /good/) { + 'This template should not produce warnings.'.$bad; +} +}} +EOT + +$template = Text::Template->new(type => 'STRING', source => $template); +isa_ok $template, 'Text::Template'; + +my $result = $template->fill_in(HASH => { good => 'good' }); + +$result =~ s/(?:^\s+)|(?:\s+$)//gs; +is $result, 'This template should not produce warnings.'; + +# see https://github.com/mschout/perl-text-template/issues/10 +$template = Text::Template->new(type => 'STRING', package => 'MY', source => ''); +$template->fill_in(package => 'MY', hash => { include => sub { 'XX' } }); + +$template = Text::Template->new(type => 'STRING', package => 'MY', source => ''); +$template->fill_in(package => 'MY', hash => { include => sub { 'XX' } }); + +done_testing; |