From 8d07cc757d6a93911ad0f57ba6e4c114f9bb6888 Mon Sep 17 00:00:00 2001 From: Marius Gavrilescu Date: Fri, 17 Jul 2015 15:26:26 +0300 Subject: [PATCH] Simplify tests --- t/01-constants.t | 135 +++++++++++++++++++++----------------------- t/Cheese.pm | 18 +++--- t/ReEntrancyTest.pm | 5 +- t/cheese.pl | 5 +- 4 files changed, 80 insertions(+), 83 deletions(-) diff --git a/t/01-constants.t b/t/01-constants.t index b9de1b3..22ef038 100644 --- a/t/01-constants.t +++ b/t/01-constants.t @@ -1,55 +1,48 @@ -#!/usr/bin/perl -w - +#!/usr/bin/perl use strict; -use Test::More tests => 20; -use Data::Dumper; - -use vars qw($section_1 $section_2 $section_3 $section_4 %options); - -use_ok( - "Pod::Constants", - section_1 => \$section_1, - -trim => 1, - section_2 => \$section_2, - section_3 => sub { tr/[a-z]/[A-Z]/; $section_3 = $_ }, - section_4 => sub { eval }, - 'command line parameters' => sub { - &Pod::Constants::add_hook - ( - #-trim => 0, - '*item' => sub { - my ($options, $description) = - m/^(.*?)\n\n(.*)/s; - my (@options, $longest); - $longest = ""; - for my $option - ($options =~ m/\G((?:-\w|--\w+))(?:,\s*)?/g) { - push @options, $option; - if ( length $option > length $longest) { - $longest = $option; - } - } - $longest =~ s/^-*//; - $options{$longest} = - { - options => \@options, - description => $description, - }; - } - ) - }, - ); - -# try as hard as we can to get the path to perl -ok($Pod::Constants::VERSION, - "Pod::Constants sets its own VERSION"); - -BEGIN { - push @INC, "t"; -}; +use warnings; +use lib 't'; + +use File::Temp qw/tempfile/; +use Test::More tests => 19; + +our ($section_1, $section_2, $section_3, $section_4, %options); + +sub handle_item { + my ($options, $description) = m/^(.*?)\n\n(.*)/s; + my (@options, $longest); + $longest = ""; + for my $option ($options =~ m/\G((?:-\w|--\w+))(?:,\s*)?/g) { + push @options, $option; + $longest = $option if length $option > length $longest + } + $longest =~ s/^-*//; + $options{$longest} = { + options => \@options, + description => $description, + }; +} + +sub run_parser { + Pod::Constants->import( + section_1 => \$section_1, + -trim => 1, + section_2 => \$section_2, + section_3 => sub { tr/[a-z]/[A-Z]/; $section_3 = $_ }, + section_4 => sub { eval }, + 'command line parameters' => sub { + Pod::Constants::add_hook('*item' => \&handle_item) + }); +} + +use_ok('Pod::Constants'); +run_parser; + +ok $Pod::Constants::VERSION, "Pod::Constants sets its own VERSION"; + # to avoid a warning if ( 0 ) { $Cheese::foo = $ReEntrancyTest::wohoo = $Cheese::quux; } -eval "use Cheese"; +eval 'use Cheese'; is($section_1, "Down with Pants!\n\n", "no trim from main"); is($section_2, "42", "with trim from main"); @@ -68,39 +61,41 @@ Pod::Constants->import (SYNOPSIS => sub { }); package main; -open NEWPKG, ">t/TestManPage.pm" or die $!; # why define your test results when you can read them in from POD? $section_1 =~ s/myhash\)/myhash, %myhash2)/; $section_1 =~ s/myhash;/myhash, "%myhash\'s value after the above:" => sub { %myhash2 = eval };/; -print NEWPKG "package TestManPage;\n$section_1\n2.818;\n"; -close NEWPKG; - -use_ok("TestManPage"); - -is($TestManPage::myvar, 'This string will be loaded into $myvar', - "man page example 1"); -is($TestManPage::VERSION, $Pod::Constants::VERSION, - "man page example 2"); -ok($TestManPage::VERSION, - "man page example 2 cross-check"); -is($TestManPage::myarray[2], 'For example, this is $myarray[2].', - "man page example 3"); + +my ($fh, $file) = tempfile 'pod-constants-testXXXX', TMPDIR => 1, UNLINK => 1; +print $fh <<"EOF"; +package TestManPage; +$section_1; +1 +EOF +close $fh; + +$INC{'TestManPage.pm'} = $file; +require $file; + +is $TestManPage::myvar, 'This string will be loaded into $myvar',"man page example 1"; +is $TestManPage::VERSION, $Pod::Constants::VERSION, "man page example 2"; +ok $TestManPage::VERSION, "man page example 2 cross-check"; +is $TestManPage::myarray[2], 'For example, this is $myarray[2].', "man page example 3"; + my $ok = 0; while (my ($k, $v) = each %TestManPage::myhash) { if (exists $TestManPage::myhash2{$k}) { $ok ++ }; if ($v eq $TestManPage::myhash2{$k}) { $ok ++ }; } -is($ok, 4, - "man page example 4"); -is(scalar keys %TestManPage::myhash, 2, - "man page example 4 cross-check"); -is($TestManPage::html, '

This text will be in $html

', - "man page example 5"); + +is $ok, 4, "man page example 4"; +is scalar keys %TestManPage::myhash, 2, "man page example 4 cross-check"; +is $TestManPage::html, '

This text will be in $html

', "man page example 5"; + # supress warnings $TestManPage::myvar = $TestManPage::html = undef; @TestManPage::myarray = (); -is($options{foo}->{options}->[0], "-f", "Pod::Constants::add_hook"); +is $options{foo}->{options}->[0], "-f", "Pod::Constants::add_hook"; =head2 section_1 diff --git a/t/Cheese.pm b/t/Cheese.pm index db18104..6d234c5 100644 --- a/t/Cheese.pm +++ b/t/Cheese.pm @@ -1,14 +1,16 @@ package Cheese; - use strict; +use warnings; + +our ($foo, $quux); + +sub handle_bar { + print "GOT HERE\n"; + eval 'use ReEntrancyTest'; + print "GOT HERE TOO. \$\@ is `$@'\n"; +} -use vars qw($foo $quux); -use Pod::Constants -debug => 1, -trim => 1, - foo => \$foo, - bar => sub { print "GOT HERE\n"; eval "use ReEntrancyTest"; - print "GOT HERE TOO. \$\@ is `$@'\n"; }, - quux => \$quux, -; +use Pod::Constants -debug => 1, -trim => 1, foo => \$foo, bar => \&handle_bar, quux => \$quux; =head1 foo diff --git a/t/ReEntrancyTest.pm b/t/ReEntrancyTest.pm index e6fc08b..44f68a5 100644 --- a/t/ReEntrancyTest.pm +++ b/t/ReEntrancyTest.pm @@ -1,9 +1,8 @@ - package ReEntrancyTest; - use strict; -use vars qw($wohoo $foo); +use warnings; +our $wohoo; use Pod::Constants -debug => 1, -trim => 1, foobar => \$wohoo; =head1 foobar diff --git a/t/cheese.pl b/t/cheese.pl index 11393f4..f0fdbef 100644 --- a/t/cheese.pl +++ b/t/cheese.pl @@ -1,7 +1,8 @@ - use strict; +use warnings; + +our $foo; -use vars qw($foo); use Pod::Constants -trim => 1, foo => \$foo; =head1 foo -- 2.39.2