#!/usr/bin/env perl
# [[[ PRE-HEADER ]]]
# suppress 'WEXRP00: Found multiple rperl executables' due to blib/ & pre-existing installation(s),
# also 'WARNING WCOCODE00, COMPILER, FIND DEPENDENCIES: Failed to eval-use package' due to RPerl/Test/*/*Bad*.pm & RPerl/Test/*/*bad*.pl
BEGIN { $ENV{RPERL_WARNINGS} = 0; }
# [[[ HEADER ]]]
use strict;
use warnings;
use RPerl::AfterSubclass;
our $VERSION = 0.005_000;
# [[[ CRITICS ]]]
## no critic qw(ProhibitUselessNoCritic ProhibitMagicNumbers RequireCheckedSyscalls) # USER DEFAULT 1: allow numeric values & print operator
## no critic qw(RequireInterpolationOfMetachars) # USER DEFAULT 2: allow single-quoted control characters & sigils
## no critic qw(RequireCheckingReturnValueOfEval) ## SYSTEM DEFAULT 4: allow eval() test code blocks
# [[[ INCLUDES ]]]
use Test::More tests => 254;
use Test::Exception;
use Test::Number::Delta;
use RPerl::Test;
use File::Copy;
use Module::Refresh;
use RPerl::Algorithm::Sort::Bubble; # initial 'use' to call RPerl::Algorithm::Sort::Bubble::import() before subsequent calls to 'require' only
# [[[ OPERATIONS ]]]
BEGIN {
if ( $ENV{RPERL_VERBOSE} ) {
diag('[[[ Beginning Pre-Compiled Sort Pre-Test Loading, RPerl Compilation System ]]]');
}
lives_and( sub { use_ok('RPerl'); }, q{use_ok('RPerl') lives} );
# NEED FIX: duplicate code, is it redundant to do this here and also at the top of the main for() loop?
my string $bubble_cpp_filename = $RPerl::INCLUDE_PATH . '/RPerl/Algorithm/Sort/Bubble.cpp';
my string $bubble_h_filename = $RPerl::INCLUDE_PATH . '/RPerl/Algorithm/Sort/Bubble.h';
my string $bubble_pmc_filename = $RPerl::INCLUDE_PATH . '/RPerl/Algorithm/Sort/Bubble.pmc';
my string $sort_cpp_filename = $RPerl::INCLUDE_PATH . '/RPerl/Algorithm/Sort.cpp';
my string $sort_h_filename = $RPerl::INCLUDE_PATH . '/RPerl/Algorithm/Sort.h';
my string $sort_pmc_filename = $RPerl::INCLUDE_PATH . '/RPerl/Algorithm/Sort.pmc';
my string $algorithm_cpp_filename = $RPerl::INCLUDE_PATH . '/RPerl/Algorithm.cpp';
my string $algorithm_h_filename = $RPerl::INCLUDE_PATH . '/RPerl/Algorithm.h';
my string $algorithm_pmc_filename = $RPerl::INCLUDE_PATH . '/RPerl/Algorithm.pmc';
# RPerl::diag('in 11_precompiled_sort.t, have $bubble_pmc_filename = ' . $bubble_pmc_filename . "\n");
# NEED FIX: triplicate code, is it redundant to do this here and also at the top of the main for() loop?
# delete CPP, H, and PMC files if they exist;
# for PERLOPS_PERLTYPES we need none of these files; for CPPOPS_xTYPES we need the proper manually-compiled files, not some other files
foreach my string $filename (
@{ [ $bubble_cpp_filename, $bubble_h_filename, $bubble_pmc_filename, $sort_cpp_filename, $sort_h_filename,
$sort_pmc_filename, $algorithm_cpp_filename, $algorithm_h_filename, $algorithm_pmc_filename
]
}
)
{
if ( -e $filename ) {
my integer $unlink_success = unlink $filename;
if ($unlink_success) {
ok( 1, 'Unlink (delete) existing file ' . $filename );
}
else {
ok( 0, 'Unlink (delete) existing file ' . $filename . q{ ... } . $OS_ERROR );
# skip all tests in this mode if we cannot remove the PMC file (and presumably the other 2 modes, as well)
next;
}
}
else {
ok( 1, 'No need to unlink (delete) existing file ' . $filename );
}
}
# DEV NOTE, CORRELATION #rp015: suppress 'Too late to run INIT block' at run-time loading via require or eval
lives_and( sub { require_ok('RPerl::Algorithm::Sort::Bubble'); }, q{require_ok('RPerl::Algorithm::Sort::Bubble') lives} );
}
my string $module_filenamename = 'RPerl/Algorithm/Sort/Bubble.pm';
my object $refresher = Module::Refresh->new();
# NEED FIX: duplicate code
my string $bubble_cpp_filename = $RPerl::INCLUDE_PATH . '/RPerl/Algorithm/Sort/Bubble.cpp';
my string $bubble_cpp_filename_manual = $bubble_cpp_filename . '.CPPOPS_DUALTYPES';
my string $bubble_h_filename = $RPerl::INCLUDE_PATH . '/RPerl/Algorithm/Sort/Bubble.h';
my string $bubble_h_filename_manual = $bubble_h_filename . '.CPPOPS_DUALTYPES';
my string $bubble_pmc_filename = $RPerl::INCLUDE_PATH . '/RPerl/Algorithm/Sort/Bubble.pmc';
my string $bubble_pmc_filename_manual = $bubble_pmc_filename . '.CPPOPS_DUALTYPES';
my string $sort_cpp_filename = $RPerl::INCLUDE_PATH . '/RPerl/Algorithm/Sort.cpp';
my string $sort_cpp_filename_manual = $sort_cpp_filename . '.CPPOPS_DUALTYPES';
my string $sort_h_filename = $RPerl::INCLUDE_PATH . '/RPerl/Algorithm/Sort.h';
my string $sort_h_filename_manual = $sort_h_filename . '.CPPOPS_DUALTYPES';
my string $sort_pmc_filename = $RPerl::INCLUDE_PATH . '/RPerl/Algorithm/Sort.pmc';
my string $sort_pmc_filename_manual = $sort_pmc_filename . '.CPPOPS_DUALTYPES';
my string $algorithm_cpp_filename = $RPerl::INCLUDE_PATH . '/RPerl/Algorithm.cpp';
my string $algorithm_cpp_filename_manual = $algorithm_cpp_filename . '.CPPOPS_DUALTYPES';
my string $algorithm_h_filename = $RPerl::INCLUDE_PATH . '/RPerl/Algorithm.h';
my string $algorithm_h_filename_manual = $algorithm_h_filename . '.CPPOPS_DUALTYPES';
my string $algorithm_pmc_filename = $RPerl::INCLUDE_PATH . '/RPerl/Algorithm.pmc';
my string $algorithm_pmc_filename_manual = $algorithm_pmc_filename . '.CPPOPS_DUALTYPES';
#RPerl::diag('in 11_precompiled_sort.t, have $bubble_pmc_filename = ' . $bubble_pmc_filename . "\n");
#RPerl::diag('in 11_precompiled_sort.t, have $bubble_pmc_filename_manual = ' . $bubble_pmc_filename_manual . "\n");
# [[[ PRIMARY RUNLOOP ]]]
# [[[ PRIMARY RUNLOOP ]]]
# [[[ PRIMARY RUNLOOP ]]]
# loop 3 times, once for each mode: PERLOPS_PERLTYPES, PERLOPS_CPPTYPES, CPPOPS_CPPTYPES
foreach my integer $mode_id ( sort keys %{$RPerl::MODES} ) {
#for my $mode_id ( 1 .. 2 ) { # TEMPORARY DEBUGGING xOPS_xTYPES ONLY
# [[[ MODE SETUP ]]]
# RPerl::diag("in 11_precompiled_sort.t, top of for() loop, have \$mode_id = $mode_id\n");
my scalartype_hashref $mode = $RPerl::MODES->{$mode_id};
my $ops = $mode->{ops};
my $types = $mode->{types};
my string $mode_tagline = $ops . 'OPS_' . $types . 'TYPES';
if ( $ENV{RPERL_VERBOSE} ) {
Test::More::diag( '[[[ Beginning Pre-Compiled Sort Tests, RPerl Compilation System, ' . $ops . ' Operations & ' . $types . ' Data Types' . ' ]]]' );
}
lives_ok( sub { rperltypes::types_enable($types) }, q{Mode '} . $ops . ' Operations & ' . $types . ' Data Types' . q{' enabled in CPP header file(s)} );
# NEED FIX: triplicate code
# delete CPP, H, and PMC files if they exist;
# for PERLOPS_PERLTYPES we need none of these files; for CPPOPS_xTYPES we need the proper manually-compiled files, not some other files
foreach my string $filename (
@{ [ $bubble_cpp_filename, $bubble_h_filename, $bubble_pmc_filename, $sort_cpp_filename, $sort_h_filename,
$sort_pmc_filename, $algorithm_cpp_filename, $algorithm_h_filename, $algorithm_pmc_filename
]
}
)
{
if ( -e $filename ) {
my integer $unlink_success = unlink $filename;
if ($unlink_success) {
ok( 1, 'Unlink (delete) existing file ' . $filename );
}
else {
ok( 0, 'Unlink (delete) existing file ' . $filename . q{ ... } . $OS_ERROR );
# skip all tests in this mode if we cannot remove the PMC file (and presumably the other 2 modes, as well)
next;
}
}
else {
ok( 1, 'No need to unlink (delete) existing file ' . $filename );
}
}
if ( $ops eq 'PERL' ) {
# RPerl::diag('in 11_precompiled_sort.t, have Bubble symtab entries:' . "\n" . RPerl::analyze_class_symtab_entries('RPerl::Algorithm::Sort::Bubble') . "\n\n");
}
else { # $ops eq 'CPP'
foreach my string_arrayref $filenames (
@{ [ [ $bubble_cpp_filename, $bubble_cpp_filename_manual ],
[ $bubble_h_filename, $bubble_h_filename_manual ],
[ $bubble_pmc_filename, $bubble_pmc_filename_manual ],
[ $sort_cpp_filename, $sort_cpp_filename_manual ],
[ $sort_h_filename, $sort_h_filename_manual ],
[ $sort_pmc_filename, $sort_pmc_filename_manual ],
[ $algorithm_cpp_filename, $algorithm_cpp_filename_manual ],
[ $algorithm_h_filename, $algorithm_h_filename_manual ],
[ $algorithm_pmc_filename, $algorithm_pmc_filename_manual ]
]
}
)
{
my string $filename = $filenames->[0];
my string $filename_manual = $filenames->[1];
my string $filename_short = $filename;
my string $filename_manual_short = $filename_manual;
if ( ( length $filename_short ) > 55 ) { $filename_short = '...' . substr $filename_short, -55; }
if ( ( length $filename_manual_short ) > 55 ) { $filename_manual_short = '...' . substr $filename_manual_short, -55; }
if ( -e ($filename_manual) ) {
my integer $copy_success = copy( $filename_manual, $filename );
if ($copy_success) {
ok( 1, 'Copy manually-compiled file ' . $filename_manual_short . ' to ' . $filename_short );
}
else {
ok( 0, 'Copy manually-compiled file ' . $filename_manual_short . ' to ' . $filename_short . q{ ... } . $OS_ERROR );
}
}
else {
ok( 0, 'Copy manually-compiled file ' . $filename_manual_short . ' to ' . $filename_short . q{ ... } . 'File does not exist' );
}
}
# C++ use, load, link
lives_ok( sub { $refresher->refresh_module($module_filenamename) }, 'Refresh previously-loaded module: ' . $module_filenamename );
# DEV NOTE, CORRELATION #rp015: suppress 'Too late to run INIT block' at run-time loading via require or eval
lives_and( sub { require_ok('RPerl::Algorithm::Sort::Bubble'); }, q{require_ok('RPerl::Algorithm::Sort::Bubble') lives} );
# force reload
delete $main::{'RPerl__Algorithm__Sort__Bubble__MODE_ID'};
# DEV NOTE: must call long form of cpp_load() to bypass mysterious 'undefined subroutine' symtab weirdness
#lives_ok( sub { RPerl::Algorithm::Sort::Bubble::cpp_load(); }, q{RPerl::Algorithm::Sort::Bubble::cpp_load() lives} );
lives_ok( sub { &{ $RPerl::Algorithm::Sort::Bubble::{'cpp_load'} }(); }, q{RPerl::Algorithm::Sort::Bubble::cpp_load() lives} ); # long form
#RPerl::diag('in 11_precompiled_sort.t, have post-re-use, post-re-cpp_load Bubble symtab entries:' . "\n" . RPerl::analyze_class_symtab_entries('RPerl::Algorithm::Sort::Bubble') . "\n\n");
}
foreach my string $type (qw(DataType__Integer DataType__Number DataType__String DataStructure__Array DataStructure__Hash Algorithm__Sort__Bubble)) {
lives_and(
sub {
is( $RPerl::MODES->{ main->can( 'RPerl__' . $type . '__MODE_ID' )->() }->{ops},
$ops, 'main::RPerl__' . $type . '__MODE_ID() ops returns ' . $ops );
},
'main::RPerl__' . $type . '__MODE_ID() lives'
);
lives_and(
sub {
is( $RPerl::MODES->{ main->can( 'RPerl__' . $type . '__MODE_ID' )->() }->{types},
$types, 'main::RPerl__' . $type . '__MODE_ID() types returns ' . $types );
},
'main::RPerl__' . $type . '__MODE_ID() lives'
);
}
# [[[ INTEGER SORT TESTS ]]]
# [[[ INTEGER SORT TESTS ]]]
# [[[ INTEGER SORT TESTS ]]]
throws_ok( # TIVALSOBU00
sub { integer_bubblesort() },
"/(EIVAVRV00.*$mode_tagline)|(Usage.*integer_bubblesort)/", # DEV NOTE: 2 different error messages, RPerl & C
q{TIVALSOBU00 integer_bubblesort() throws correct exception}
);
throws_ok( # TIVALSOBU01
sub { RPerl::Algorithm::Sort::Bubble::integer_bubblesort(undef) },
"/EIVAVRV00.*$mode_tagline/",
q{TIVALSOBU01 RPerl::Algorithm::Sort::Bubble::integer_bubblesort(undef) throws correct exception}
);
throws_ok( # TIVALSOBU02
sub { RPerl::Algorithm::Sort::Bubble::integer_bubblesort(2) },
"/EIVAVRV01.*$mode_tagline/",
q{TIVALSOBU02 RPerl::Algorithm::Sort::Bubble::integer_bubblesort(2) throws correct exception}
);
throws_ok( # TIVALSOBU03
sub { RPerl::Algorithm::Sort::Bubble::integer_bubblesort(2.3) },
"/EIVAVRV01.*$mode_tagline/",
q{TIVALSOBU03 RPerl::Algorithm::Sort::Bubble::integer_bubblesort(2.3) throws correct exception}
);
throws_ok( # TIVALSOBU04
sub { RPerl::Algorithm::Sort::Bubble::integer_bubblesort('2') },
"/EIVAVRV01.*$mode_tagline/",
q{TIVALSOBU04 RPerl::Algorithm::Sort::Bubble::integer_bubblesort('2') throws correct exception}
);
throws_ok( # TIVALSOBU05
sub { RPerl::Algorithm::Sort::Bubble::integer_bubblesort( { a_key => 23 } ) },
"/EIVAVRV01.*$mode_tagline/",
q{TIVALSOBU05 RPerl::Algorithm::Sort::Bubble::integer_bubblesort({a_key => 23}) throws correct exception}
);
throws_ok( # TIVALSOBU10
sub {
RPerl::Algorithm::Sort::Bubble::integer_bubblesort( [ 2, 2_112, undef, 23, -877, -33, 1_701 ] );
},
"/EIVAVRV02.*$mode_tagline/",
q{TIVALSOBU10 RPerl::Algorithm::Sort::Bubble::integer_bubblesort([2, 2_112, undef, 23, -877, -33, 1_701]) throws correct exception}
);
throws_ok( # TIVALSOBU11
sub {
RPerl::Algorithm::Sort::Bubble::integer_bubblesort( [ 2, 2_112, 42, 23.3, -877, -33, 1_701 ] );
},
"/EIVAVRV03.*$mode_tagline/",
q{TIVALSOBU11 RPerl::Algorithm::Sort::Bubble::integer_bubblesort([2, 2_112, 42, 23.3, -877, -33, 1_701]) throws correct exception}
);
throws_ok( # TIVALSOBU12
sub {
RPerl::Algorithm::Sort::Bubble::integer_bubblesort( [ 2, 2_112, 42, '23', -877, -33, 1_701 ] );
},
"/EIVAVRV03.*$mode_tagline/",
q{TIVALSOBU12 RPerl::Algorithm::Sort::Bubble::integer_bubblesort([2, 2_112, 42, '23', -877, -33, 1_701]) throws correct exception}
);
throws_ok( # TIVALSOBU13
sub {
RPerl::Algorithm::Sort::Bubble::integer_bubblesort( [ 2, 2_112, 42, [23], -877, -33, 1_701 ] );
},
"/EIVAVRV03.*$mode_tagline/",
q{TIVALSOBU13 RPerl::Algorithm::Sort::Bubble::integer_bubblesort([2, 2_112, 42, [23], -877, -33, 1_701]) throws correct exception}
);
throws_ok( # TIVALSOBU14
sub {
RPerl::Algorithm::Sort::Bubble::integer_bubblesort( [ 2, 2_112, 42, { a_subkey => 23 }, -877, -33, 1_701 ] );
},
"/EIVAVRV03.*$mode_tagline/",
q{TIVALSOBU14 RPerl::Algorithm::Sort::Bubble::integer_bubblesort([2, 2_112, 42, {a_subkey => 23}, -877, -33, 1_701]) throws correct exception}
);
lives_and( # TIVALSOBU20
sub {
is_deeply( RPerl::Algorithm::Sort::Bubble::integer_bubblesort( [23] ), [23], q{TIVALSOBU20 integer_bubblesort([23]) returns correct value} );
},
q{TIVALSOBU20 RPerl::Algorithm::Sort::Bubble::integer_bubblesort([23]) lives}
);
lives_and( # TIVALSOBU21
sub {
is_deeply(
RPerl::Algorithm::Sort::Bubble::integer_bubblesort( [ 2, 2_112, 42, 23, -877, -33, 1_701 ] ),
[ -877, -33, 2, 23, 42, 1_701, 2_112 ],
q{TIVALSOBU21 RPerl::Algorithm::Sort::Bubble::integer_bubblesort([2, 2_112, 42, 23, -877, -33, 1_701]) returns correct value}
);
},
q{TIVALSOBU21 RPerl::Algorithm::Sort::Bubble::integer_bubblesort([2, 2_112, 42, 23, -877, -33, 1_701]) lives}
);
lives_and( # TIVALSOBU22
sub {
is_deeply( RPerl::Algorithm::Sort::Bubble::integer_bubblesort( [ reverse 0 .. 7 ] ), [ 0 .. 7 ], q{TIVALSOBU22 RPerl::Algorithm::Sort::Bubble::integer_bubblesort([reverse 0 .. 7]) returns correct value} );
},
q{TIVALSOBU22 RPerl::Algorithm::Sort::Bubble::integer_bubblesort([reverse 0 .. 7]) lives}
);
lives_and( # TIVALSOBU22a
sub {
is_deeply(
eval {
my $retval = RPerl::Algorithm::Sort::Bubble::integer_bubblesort( [ reverse 0 .. 7 ] );
return $retval;
}, # DEV NOTE: does different things to Perl stack than non-eval
[ 0 .. 7 ],
q{TIVALSOBU22a eval { my $retval = RPerl::Algorithm::Sort::Bubble::integer_bubblesort( [ reverse 0 .. 7 ] ); return $retval; } returns correct value}
);
},
q{TIVALSOBU22a eval { my $retval = RPerl::Algorithm::Sort::Bubble::integer_bubblesort( [ reverse 0 .. 7 ] ); return $retval; } lives}
);
throws_ok( # TIVALSOBU30
sub { RPerl::Algorithm::Sort::Bubble::integer_bubblesort_typetest0() },
"/(EIVAVRV00.*$mode_tagline)|(Usage.*integer_bubblesort_typetest0)/"
, # DEV NOTE: 2 different error messages, RPerl & C
q{TIVALSOBU30 RPerl::Algorithm::Sort::Bubble::integer_bubblesort_typetest0() throws correct exception}
);
throws_ok( # TIVALSOBU31
sub { RPerl::Algorithm::Sort::Bubble::integer_bubblesort_typetest0(2) },
"/EIVAVRV01.*$mode_tagline/",
q{TIVALSOBU31 RPerl::Algorithm::Sort::Bubble::integer_bubblesort_typetest0(2) throws correct exception}
);
throws_ok( # TIVALSOBU32
sub {
RPerl::Algorithm::Sort::Bubble::integer_bubblesort_typetest0( [ 2, 2_112, undef, 23, -877, -33, 1_701 ] );
},
"/EIVAVRV02.*$mode_tagline/",
q{TIVALSOBU32 RPerl::Algorithm::Sort::Bubble::integer_bubblesort_typetest0([2, 2_112, undef, 23, -877, -33, 1_701]) throws correct exception}
);
throws_ok( # TIVALSOBU33
sub {
RPerl::Algorithm::Sort::Bubble::integer_bubblesort_typetest0( [ 2, 2_112, 42, 23, -877, -33, 1_701, [ 23, -42.3 ] ] );
},
"/EIVAVRV03.*$mode_tagline/",
q{TIVALSOBU33 RPerl::Algorithm::Sort::Bubble::integer_bubblesort_typetest0([2, 2_112, 42, 23, -877, -33, 1_701, [23, -42.3]]) throws correct exception}
);
lives_and( # TIVALSOBU34
sub {
is( RPerl::Algorithm::Sort::Bubble::integer_bubblesort_typetest0( [ 2, 2_112, 42, 23, -877, -33, 1_701 ] ),
'[-877, -33, 2, 23, 42, 1_701, 2_112]' . $mode_tagline,
q{TIVALSOBU34 RPerl::Algorithm::Sort::Bubble::integer_bubblesort_typetest0([2, 2_112, 42, 23, -877, -33, 1_701]) returns correct value}
);
},
q{TIVALSOBU34 RPerl::Algorithm::Sort::Bubble::integer_bubblesort_typetest0([2, 2_112, 42, 23, -877, -33, 1_701]) lives}
);
lives_and( # TIVALSOBU34a
sub {
is( eval {
my $retval = RPerl::Algorithm::Sort::Bubble::integer_bubblesort_typetest0( [ 2, 2_112, 42, 23, -877, -33, 1_701 ] );
return $retval;
},
'[-877, -33, 2, 23, 42, 1_701, 2_112]' . $mode_tagline,
q{TIVALSOBU34a eval { my $retval = RPerl::Algorithm::Sort::Bubble::integer_bubblesort_typetest0( [2, 2_112, 42, 23, -877, -33, 1_701] ); return $retval; } returns correct value}
);
},
q{TIVALSOBU34a eval { my $retval = RPerl::Algorithm::Sort::Bubble::integer_bubblesort_typetest0( [2, 2_112, 42, 23, -877, -33, 1_701] ); return $retval; } lives}
);
# [[[ NUMBER SORT TESTS ]]]
# [[[ NUMBER SORT TESTS ]]]
# [[[ NUMBER SORT TESTS ]]]
throws_ok( # TNVALSOBU00
sub { RPerl::Algorithm::Sort::Bubble::number_bubblesort() },
"/(ENVAVRV00.*$mode_tagline)|(Usage.*number_bubblesort)/", # DEV NOTE: 2 different error messages, RPerl & C
q{TNVALSOBU00 RPerl::Algorithm::Sort::Bubble::number_bubblesort() throws correct exception}
);
throws_ok( # TNVALSOBU01
sub { RPerl::Algorithm::Sort::Bubble::number_bubblesort(undef) },
"/ENVAVRV00.*$mode_tagline/",
q{TNVALSOBU01 RPerl::Algorithm::Sort::Bubble::number_bubblesort(undef) throws correct exception}
);
throws_ok( # TNVALSOBU02
sub { RPerl::Algorithm::Sort::Bubble::number_bubblesort(2) },
"/ENVAVRV01.*$mode_tagline/",
q{TNVALSOBU02 RPerl::Algorithm::Sort::Bubble::number_bubblesort(2) throws correct exception}
);
throws_ok( # TNVALSOBU03
sub { RPerl::Algorithm::Sort::Bubble::number_bubblesort(2.3) },
"/ENVAVRV01.*$mode_tagline/",
q{TNVALSOBU03 RPerl::Algorithm::Sort::Bubble::number_bubblesort(2.3) throws correct exception}
);
throws_ok( # TNVALSOBU04
sub { RPerl::Algorithm::Sort::Bubble::number_bubblesort('2') },
"/ENVAVRV01.*$mode_tagline/",
q{TNVALSOBU04 RPerl::Algorithm::Sort::Bubble::number_bubblesort('2') throws correct exception}
);
throws_ok( # TNVALSOBU05
sub { RPerl::Algorithm::Sort::Bubble::number_bubblesort( { a_key => 23 } ) },
"/ENVAVRV01.*$mode_tagline/",
q{TNVALSOBU05 RPerl::Algorithm::Sort::Bubble::number_bubblesort({a_key => 23}) throws correct exception}
);
throws_ok( # TNVALSOBU10
sub {
RPerl::Algorithm::Sort::Bubble::number_bubblesort( [ 2, 2_112, undef, 23, -877, -33, 1_701 ] );
},
"/ENVAVRV02.*$mode_tagline/",
q{TNVALSOBU10 RPerl::Algorithm::Sort::Bubble::number_bubblesort([2, 2_112, undef, 23, -877, -33, 1_701]) throws correct exception}
);
throws_ok( # TNVALSOBU11
sub {
RPerl::Algorithm::Sort::Bubble::number_bubblesort( [ 2, 2_112, 42, '23', -877, -33, 1_701 ] );
},
"/ENVAVRV03.*$mode_tagline/",
q{TNVALSOBU11 RPerl::Algorithm::Sort::Bubble::number_bubblesort([2, 2_112, 42, '23', -877, -33, 1_701]) throws correct exception}
);
throws_ok( # TNVALSOBU12
sub {
RPerl::Algorithm::Sort::Bubble::number_bubblesort( [ 2, 2_112, 42, [23], -877, -33, 1_701 ] );
},
"/ENVAVRV03.*$mode_tagline/",
q{TNVALSOBU12 RPerl::Algorithm::Sort::Bubble::number_bubblesort([2, 2_112, 42, [23], -877, -33, 1_701]) throws correct exception}
);
throws_ok( # TNVALSOBU13
sub {
RPerl::Algorithm::Sort::Bubble::number_bubblesort( [ 2, 2_112, 42, { a_subkey => 23 }, -877, -33, 1_701 ] );
},
"/ENVAVRV03.*$mode_tagline/",
q{TNVALSOBU13 RPerl::Algorithm::Sort::Bubble::number_bubblesort([2, 2_112, 42, {a_subkey => 23}, -877, -33, 1_701]) throws correct exception}
);
lives_and( # TNVALSOBU20
sub {
is_deeply( RPerl::Algorithm::Sort::Bubble::number_bubblesort( [23] ), [23], q{TNVALSOBU20 RPerl::Algorithm::Sort::Bubble::number_bubblesort([23]) returns correct value} );
},
q{TNVALSOBU20 RPerl::Algorithm::Sort::Bubble::number_bubblesort([23]) lives}
);
lives_and( # TNVALSOBU21
sub {
is_deeply(
RPerl::Algorithm::Sort::Bubble::number_bubblesort( [ 2, 2_112, 42, 23, -877, -33, 1_701 ] ),
[ -877, -33, 2, 23, 42, 1_701, 2_112 ],
q{TNVALSOBU21 RPerl::Algorithm::Sort::Bubble::number_bubblesort([2, 2_112, 42, 23, -877, -33, 1_701]) returns correct value}
);
},
q{TNVALSOBU21 RPerl::Algorithm::Sort::Bubble::number_bubblesort([2, 2_112, 42, 23, -877, -33, 1_701]) lives}
);
lives_and( # TNVALSOBU22
sub {
is_deeply( RPerl::Algorithm::Sort::Bubble::number_bubblesort( [ reverse 0 .. 7 ] ), [ 0 .. 7 ], q{TNVALSOBU22 RPerl::Algorithm::Sort::Bubble::number_bubblesort([reverse 0 .. 7]) returns correct value} );
},
q{TNVALSOBU22 RPerl::Algorithm::Sort::Bubble::number_bubblesort([reverse 0 .. 7]) lives}
);
lives_and( # TNVALSOBU22a
sub {
is_deeply(
eval {
my $retval = RPerl::Algorithm::Sort::Bubble::number_bubblesort( [ reverse 0 .. 7 ] );
return $retval;
}, # DEV NOTE: does different things to Perl stack than non-eval
[ 0 .. 7 ],
q{TNVALSOBU22a eval { my $retval = RPerl::Algorithm::Sort::Bubble::number_bubblesort( [ reverse 0 .. 7 ] ); return $retval; } returns correct value}
);
},
q{TNVALSOBU22a eval { my $retval = RPerl::Algorithm::Sort::Bubble::number_bubblesort( [ reverse 0 .. 7 ] ); return $retval; } lives}
);
lives_and( # TNVALSOBU23
sub {
# NEED DELETE OLD CODE
# is_deeply( RPerl::Algorithm::Sort::Bubble::number_bubblesort( [23.2] ), [23.2], q{TNVALSOBU23 RPerl::Algorithm::Sort::Bubble::number_bubblesort([23.2]) returns correct value} );
delta_ok( RPerl::Algorithm::Sort::Bubble::number_bubblesort( [23.2] ), [23.2], q{TNVALSOBU23 RPerl::Algorithm::Sort::Bubble::number_bubblesort([23.2]) returns correct value} );
},
q{TNVALSOBU23 RPerl::Algorithm::Sort::Bubble::number_bubblesort([23.2]) lives}
);
lives_and( # TNVALSOBU24
sub {
# NEED DELETE OLD CODE
# is_deeply(
delta_ok(
RPerl::Algorithm::Sort::Bubble::number_bubblesort( [ 2.1, 2_112.2, 42.3, 23, -877, -33, 1_701 ] ),
[ -877, -33, 2.1, 23, 42.3, 1_701, 2_112.2 ],
q{TNVALSOBU24 RPerl::Algorithm::Sort::Bubble::number_bubblesort([2.1, 2_112.2, 42.3, 23, -877, -33, 1_701]) returns correct value}
);
},
q{TNVALSOBU24 RPerl::Algorithm::Sort::Bubble::number_bubblesort([2.1, 2_112.2, 42.3, 23, -877, -33, 1_701]) lives}
);
lives_and( # TNVALSOBU25
sub {
# NEED DELETE OLD CODE
# is_deeply(
delta_ok(
RPerl::Algorithm::Sort::Bubble::number_bubblesort( [ 2.123_443_211_234_432_1, 2_112.4_321, 42.456_7, 23.765_444_444_444_444_444, -877.567_8, -33.876_587_658_765_875_687_658_765, 1_701.678_9 ] ),
[ -877.567_8, -33.876_587_658_765_9, 2.123_443_211_234_43, 23.765_444_444_444_4, 42.456_7, 1_701.678_9, 2_112.4_321 ],
q{TNVALSOBU25 RPerl::Algorithm::Sort::Bubble::number_bubblesort([2.123_443_211_234_432_1, ..., -33.876_587_658_765_875_687_658_765, 1_701.678_9]) returns correct value}
);
},
q{TNVALSOBU25 RPerl::Algorithm::Sort::Bubble::number_bubblesort([2.123_443_211_234_432_1, ..., -33.876_587_658_765_875_687_658_765, 1_701.678_9]) lives}
);
throws_ok( # TNVALSOBU30
sub { RPerl::Algorithm::Sort::Bubble::number_bubblesort_typetest0() },
"/(ENVAVRV00.*$mode_tagline)|(Usage.*number_bubblesort_typetest0)/"
, # DEV NOTE: 2 different error messages, RPerl & C
q{TNVALSOBU30 RPerl::Algorithm::Sort::Bubble::number_bubblesort_typetest0() throws correct exception}
);
throws_ok( # TNVALSOBU31
sub { RPerl::Algorithm::Sort::Bubble::number_bubblesort_typetest0(2) },
"/ENVAVRV01.*$mode_tagline/",
q{TNVALSOBU31 RPerl::Algorithm::Sort::Bubble::number_bubblesort_typetest0(2) throws correct exception}
);
throws_ok( # TNVALSOBU32
sub {
RPerl::Algorithm::Sort::Bubble::number_bubblesort_typetest0( [ 2.123_443_211_234_432_1, 2_112.4_321, undef, 23.765_444_444_444_444_444, -877.567_8, -33.876_587_658_765_875_687_658_765, 1_701.678_9 ] );
},
"/ENVAVRV02.*$mode_tagline/",
q{TNVALSOBU32 RPerl::Algorithm::Sort::Bubble::number_bubblesort_typetest0([2.123_443_211_234_432_1, 2_112.4_321, undef, ..., 1_701.678_9]) throws correct exception}
);
throws_ok( # TNVALSOBU33
sub {
RPerl::Algorithm::Sort::Bubble::number_bubblesort_typetest0(
[ 2.123_443_211_234_432_1, 2_112.4_321, 42.456_7, 23.765_444_444_444_444_444, -877.567_8, 'abcdefg', -33.876_587_658_765_875_687_658_765, 1_701.678_9 ] );
},
"/ENVAVRV03.*$mode_tagline/",
q{TNVALSOBU33 RPerl::Algorithm::Sort::Bubble::number_bubblesort_typetest0([2.123_443_211_234_432_1, ..., 'abcdefg', -33.876_587_658_765_875_687_658_765, 1_701.678_9]) throws correct exception}
);
lives_and( # TNVALSOBU34
sub {
# NEED DELETE OLD CODE
# is( RPerl::Algorithm::Sort::Bubble::number_bubblesort_typetest0( [ 2.123_443_211_234_432_1, 2_112.4_321, 42.456_7, 23.765_444_444_444_444_444, -877.567_8, -33.876_587_658_765_875_687_658_765, 1_701.678_9 ] ),
# '[-877.567_8, -33.876_587_658_765_9, 2.123_443_211_234_43, 23.765_444_444_444_4, 42.456_7, 1_701.678_9, 2_112.432_1]' . $mode_tagline,
# q{TNVALSOBU34 RPerl::Algorithm::Sort::Bubble::number_bubblesort_typetest0([2.123_443_211_234_432_1, ..., -33.876_587_658_765_875_687_658_765, 1_701.678_9]) returns correct value}
# );
my string $tmp_retval = RPerl::Algorithm::Sort::Bubble::number_bubblesort_typetest0(
[ 2.123_443_211_234_432_1, 2_112.4_321, 42.456_7, 23.765_444_444_444_444_444, -877.567_8, -33.876_587_658_765_875_687_658_765, 1_701.678_9 ] );
like(
$tmp_retval,
qr/\[-877\.567_8, -33\.876_587_658_765/,
q{TNVALSOBU34a RPerl::Algorithm::Sort::Bubble::number_bubblesort_typetest0([2.123_443_211_234_432_1, ..., -33.876_587_658_765_875_687_658_765, 1_701.678_9]) returns correct value, array beginning}
);
like(
$tmp_retval,
qr/42\.456_7, 1_701\.678_9, 2_112\.432_1\]/,
q{TNVALSOBU34b RPerl::Algorithm::Sort::Bubble::number_bubblesort_typetest0([2.123_443_211_234_432_1, ..., -33.876_587_658_765_875_687_658_765, 1_701.678_9]) returns correct value, array end}
);
like( $tmp_retval, qr/$mode_tagline/,
q{TNVALSOBU34c RPerl::Algorithm::Sort::Bubble::number_bubblesort_typetest0([2.123_443_211_234_432_1, ..., -33.876_587_658_765_875_687_658_765, 1_701.678_9]) returns correct value, mode tagline}
);
},
q{TNVALSOBU34 RPerl::Algorithm::Sort::Bubble::number_bubblesort_typetest0([2.123_443_211_234_432_1, ..., -33.876_587_658_765_875_687_658_765, 1_701.678_9]) lives}
);
# same as TNVALSOBU34, but inside an eval block
lives_and( # TNVALSOBU35
sub {
# NEED DELETE OLD CODE
# is( eval {
# my $retval = RPerl::Algorithm::Sort::Bubble::number_bubblesort_typetest0( [ 2.123_443_211_234_432_1, 2_112.4_321, 42.456_7, 23.765_444_444_444_444_444, -877.567_8, -33.876_587_658_765_875_687_658_765, 1_701.678_9 ] );
# return $retval;
# },
# '[-877.567_8, -33.876_587_658_765_9, 2.123_443_211_234_43, 23.765_444_444_444_4, 42.456_7, 1_701.678_9, 2_112.432_1]' . $mode_tagline,
# q{TNVALSOBU35 eval { my $retval = RPerl::Algorithm::Sort::Bubble::number_bubblesort_typetest0( [2.123_443_211_234_432_1, ..., 1_701.678_9] ); return $retval; } returns correct value}
# );
my string $tmp_retval = eval {
my $inner_retval
= RPerl::Algorithm::Sort::Bubble::number_bubblesort_typetest0(
[ 2.123_443_211_234_432_1, 2_112.4_321, 42.456_7, 23.765_444_444_444_444_444, -877.567_8, -33.876_587_658_765_875_687_658_765, 1_701.678_9 ] );
return $inner_retval;
};
like(
$tmp_retval,
qr/\[-877\.567_8, -33\.876_587_658_765/,
q{TNVALSOBU35 eval { my $inner_retval = RPerl::Algorithm::Sort::Bubble::number_bubblesort_typetest0( [2.123_443_211_234_432_1, ..., 1_701.678_9] ); return $inner_retval; } returns correct value, array beginning}
);
like(
$tmp_retval,
qr/42\.456_7, 1_701\.678_9, 2_112\.432_1\]/,
q{TNVALSOBU35 eval { my $inner_retval = RPerl::Algorithm::Sort::Bubble::number_bubblesort_typetest0( [2.123_443_211_234_432_1, ..., 1_701.678_9] ); return $inner_retval; } returns correct value, array end}
);
like( $tmp_retval, qr/$mode_tagline/,
q{TTNVALSOBU35 eval { my $inner_retval = RPerl::Algorithm::Sort::Bubble::number_bubblesort_typetest0( [2.123_443_211_234_432_1, ..., 1_701.678_9] ); return $inner_retval; } returns correct value, mode tagline}
);
},
q{TNVALSOBU35 eval { my $inner_retval = RPerl::Algorithm::Sort::Bubble::number_bubblesort_typetest0( [2.123_443_211_234_432_1, ..., 1_701.678_9] ); return $inner_retval; } lives}
);
}
# NEED FIX: triplicate code
# delete CPP, H, and PMC files if they exist;
# for PERLOPS_PERLTYPES we need none of these files; for CPPOPS_xTYPES we need the proper manually-compiled files, not some other files
foreach my string $filename (
@{ [ $bubble_cpp_filename, $bubble_h_filename, $bubble_pmc_filename, $sort_cpp_filename, $sort_h_filename,
$sort_pmc_filename, $algorithm_cpp_filename, $algorithm_h_filename, $algorithm_pmc_filename
]
}
)
{
if ( -e $filename ) {
my integer $unlink_success = unlink $filename;
if ($unlink_success) {
ok( 1, 'Unlink (delete) existing file ' . $filename );
}
else {
ok( 0, 'Unlink (delete) existing file ' . $filename . q{ ... } . $OS_ERROR );
# skip all tests in this mode if we cannot remove the PMC file (and presumably the other 2 modes, as well)
next;
}
}
else {
ok( 1, 'No need to unlink (delete) existing file ' . $filename );
}
}
done_testing();