"Fossies" - the Fresh Open Source Software Archive

Member "RPerl-5.002000/t/08_type_gsl.t.DISABLED_GSL_DEV" (30 Aug 2019, 13302 Bytes) of package /linux/misc/RPerl-5.002000.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. See also the last Fossies "Diffs" side-by-side code changes report for "08_type_gsl.t.DISABLED_GSL_DEV": 4.001000_vs_4.002000.

    1 #!/usr/bin/env perl
    2 
    3 # [[[ PRE-HEADER ]]]
    4 # suppress 'WEXRP00: Found multiple rperl executables' due to blib/ & pre-existing installation(s)
    5 BEGIN { $ENV{RPERL_WARNINGS} = 0; }
    6 
    7 # [[[ HEADER ]]]
    8 use strict;
    9 use warnings;
   10 #use RPerl::AfterSubclass;  # NEED FIX: moved by bulk88 to below BEGIN block to optimize for skip speed on Windows OS, should be 'use RPerlish;' ?
   11 our $VERSION = 0.001_000;
   12 
   13 # [[[ CRITICS ]]]
   14 ## no critic qw(ProhibitUselessNoCritic ProhibitMagicNumbers RequireCheckedSyscalls)  # USER DEFAULT 1: allow numeric values & print operator
   15 ## no critic qw(ProhibitStringySplit ProhibitInterpolationOfLiterals)  # DEVELOPER DEFAULT 2: allow string test values
   16 ## no critic qw(ProhibitStringyEval)  # SYSTEM DEFAULT 1: allow eval()
   17 ## no critic qw(RequireInterpolationOfMetachars)  # USER DEFAULT 2: allow single-quoted control characters & sigils
   18 ## no critic qw(RequireCheckingReturnValueOfEval)  # SYSTEM DEFAULT 4: allow eval() test code blocks
   19 
   20 # [[[ INCLUDES ]]]
   21 
   22 use Test::More;
   23 
   24 =DISABLED_NEED_TEST_WINDOWS
   25 BEGIN {
   26     use English;
   27     if ( $OSNAME eq 'MSWin32' ) {
   28         plan skip_all => "[[[ MS Windows OS Detected, GNU Multi-Precision Library Temporarily Disabled, Skipping GSL Type Tests, RPerl Type System ]]]";
   29     }
   30 }
   31 =cut
   32 
   33 use RPerl::AfterSubclass;  # NEED FIX: should not be here, see NEED FIX in HEADER above
   34 use RPerl::Test;
   35 use RPerl::Test::Foo;
   36 use rperltypesconv;
   37 use Test::Exception;
   38 use Test::Number::Delta;
   39 #use RPerl::DataStructure::GSLMatrix;  # IS THIS NEEDED?
   40 
   41 # [[[ OPERATIONS ]]]
   42 
   43 BEGIN {
   44     plan tests => 43;
   45     if ( $ENV{RPERL_VERBOSE} ) {
   46         Test::More::diag("[[[ Beginning GSL Type Pre-Test Loading, RPerl Type System ]]]");
   47     }
   48     lives_and( sub { use_ok('RPerl::AfterSubclass'); },            q{use_ok('RPerl::AfterSubclass') lives} );
   49     lives_and( sub { use_ok('rperlgsl'); }, q{use_ok('rperlgsl') lives} );
   50 #    lives_and( sub { use_ok('RPerl::DataType::GSLMatrix_cpp'); }, q{use_ok('RPerl::DataType::GSLMatrix_cpp') lives} );  # NEED UPGRADE: create CPP code
   51 }
   52 
   53 my integer $number_of_tests_run = 2;  # initialize to 2 for use_ok() calls in BEGIN block above
   54 
   55 # use Data::Dumper() to stringify a string
   56 sub string_dumperify {
   57     ( my string $input_string ) = @_;
   58 
   59     #    RPerl::diag("in 08_type_gsl.t string_dumperify(), received have \$input_string =\n$input_string\n\n");
   60     $input_string = Dumper( [$input_string] );
   61     $input_string =~ s/^\s+|\s+$//xmsg;    # strip leading whitespace
   62     my @input_string_split = split "\n", $input_string;
   63     $input_string = $input_string_split[1];    # only select the data line
   64     return $input_string;
   65 }
   66 
   67 # [[[ PRIMARY RUNLOOP ]]]
   68 # [[[ PRIMARY RUNLOOP ]]]
   69 # [[[ PRIMARY RUNLOOP ]]]
   70 
   71 # loop 3 times, once for each mode: PERLOPS_PERLTYPES, PERLOPS_CPPTYPES, CPPOPS_CPPTYPES
   72 #foreach my integer $mode_id ( sort keys %{$RPerl::MODES} ) {
   73 #for my $mode_id ( 0, 2 ) {    # DEV NOTE: PERLOPS_PERLTYPES & CPPOPS_CPPTYPES only currently supported
   74 for my $mode_id ( 0 ) {    # DEV NOTE: PERLOPS_PERLTYPES only currently supported
   75 #for my $mode_id ( 1 .. 1 ) {  # TEMPORARY DEBUGGING CPPOPS_PERLTYPES ONLY
   76 
   77     # [[[ MODE SETUP ]]]
   78     #    RPerl::diag("in 08_type_gsl.t, top of for() loop, have \$mode_id = $mode_id\n");
   79     my scalartype_hashref $mode = $RPerl::MODES->{$mode_id};
   80     my string $ops              = $mode->{ops};
   81     my string $types            = $mode->{types};
   82     my string $mode_tagline     = $ops . 'OPS_' . $types . 'TYPES';
   83     if ( $ENV{RPERL_VERBOSE} ) {
   84         Test::More::diag( '[[[ Beginning RPerl GSL Type Tests, ' . $ops . ' Operations & ' . $types . ' Data Types' . ' ]]]' );
   85     }
   86 
   87     #    $RPerl::DEBUG = 1;
   88     #    RPerl::diag('have $ops = ' . $ops . "\n");
   89     #    RPerl::diag('have $types = ' . $types . "\n");
   90     #    RPerl::diag('have $mode_tagline = ' . $mode_tagline . "\n");
   91 
   92     lives_ok( sub { rperltypes::types_enable($types) }, q{mode '} . $ops . ' Operations & ' . $types . ' Data Types' . q{' enabled} );
   93     $number_of_tests_run++;
   94 
   95     if ( $ops eq 'CPP' ) {
   96 
   97         # force reload
   98         delete $main::{'RPerl__DataStructure__GSLMatrix__MODE_ID'};
   99 
  100         my $package = 'RPerl::DataType::GSLMatrix_cpp';
  101         lives_and( sub { require_ok($package); }, 'require_ok(' . $package . ') lives' );
  102         $number_of_tests_run++;
  103   
  104         #            lives_and( sub { use_ok($package); }, 'use_ok(' . $package . ') lives' );
  105 
  106         lives_ok( sub { eval( $package . '::cpp_load();' ) }, $package . '::cpp_load() lives' );
  107         $number_of_tests_run++;
  108     }
  109 
  110     lives_ok( sub { main->can('RPerl__DataStructure__GSLMatrix__MODE_ID') }, 'main::RPerl__DataStructure__GSLMatrix__MODE_ID() exists' );
  111     $number_of_tests_run++;
  112 
  113 #RPerl::diag('in 08_type_gsl.t, top of for() loop, have $RPerl::MODES = ' . "\n" . Dumper($RPerl::MODES) . "\n");
  114 #RPerl::diag('in 08_type_gsl.t, top of for() loop, have RPerl__DataType__ . $type . __MODE_ID = RPerl__DataStructure__GSLMatrix__MODE_ID' . "\n");
  115 #RPerl::diag('in 08_type_gsl.t, top of for() loop, have main::RPerl__DataStructure__GSLMatrix__MODE_ID() = ' . main::RPerl__DataStructure__GSLMatrix__MODE_ID() . "\n");
  116 #RPerl::diag('in 08_type_gsl.t, top of for() loop, have eval(main::RPerl__DataStructure__GSLMatrix__MODE_ID()) = ' . eval('main::RPerl__DataStructure__GSLMatrix__MODE_ID()') . "\n");
  117 #RPerl::diag('in 08_type_gsl.t, top of for() loop, have main->can(...) = ' . main->can( 'RPerl__DataStructure__GSLMatrix__MODE_ID' ) . "\n");
  118 #RPerl::diag('in 08_type_gsl.t, top of for() loop, have main->can(...)->() = ' . main->can( 'RPerl__DataStructure__GSLMatrix__MODE_ID' )->() . "\n");
  119 #die 'TMP DEBUG';
  120 
  121     lives_and(
  122         sub {
  123             is( $RPerl::MODES->{ main->can('RPerl__DataStructure__GSLMatrix__MODE_ID')->() }->{types},
  124                 $types, 'main::RPerl__DataStructure__GSLMatrix__MODE_ID() types returns ' . $types );
  125         },
  126         'main::RPerl__DataStructure__GSLMatrix__MODE_ID() lives'
  127     );
  128     $number_of_tests_run++;
  129  
  130     # [[[ TYPE CHECKING TESTS ]]]
  131     # [[[ TYPE CHECKING TESTS ]]]
  132     # [[[ TYPE CHECKING TESTS ]]]
  133 
  134     throws_ok(    # TGIV000
  135         sub { gsl_matrix_to_string() },
  136         "/(EMAV00.*$mode_tagline)|(Usage.*gsl_matrix_to_string)/",    # DEV NOTE: 2 different error messages, RPerl & C
  137         q{TGIV000 gsl_matrix_to_string() throws correct exception}
  138     );
  139 
  140     throws_ok(    # TGIV001
  141         sub { gsl_matrix_to_string(undef) },
  142         "/(EMAV00.*$mode_tagline)/",
  143         q{TGIV001 gsl_matrix_to_string(undef) throws correct exception}
  144     );
  145 
  146     throws_ok(    # TGIV002
  147         sub { gsl_matrix_to_string(0) },
  148         "/(EMAV01.*$mode_tagline)/",
  149         q{TGIV002 gsl_matrix_to_string(0) throws correct exception}
  150     );
  151 
  152     throws_ok(    # TGIV003
  153         sub { gsl_matrix_to_string(-23.42) },
  154         "/(EMAV01.*$mode_tagline)/",
  155         q{TGIV003 gsl_matrix_to_string(-23.42) throws correct exception}
  156     );
  157 
  158     throws_ok(    # TGIV004
  159         sub { gsl_matrix_to_string('howdy') },
  160         "/(EMAV01.*$mode_tagline)/",
  161         q{TGIV004 gsl_matrix_to_string('howdy') throws correct exception}
  162     );
  163 
  164     throws_ok(    # TGIV005
  165         sub { gsl_matrix_to_string([]) },
  166         "/(EMAV01.*$mode_tagline)/",
  167         q{TGIV005 gsl_matrix_to_string([]) throws correct exception}
  168     );
  169 
  170     throws_ok(    # TGIV006
  171         sub { gsl_matrix_to_string([21, 12, 23]) },
  172         "/(EMAV01.*$mode_tagline)/",
  173         q{TGIV006 gsl_matrix_to_string([21, 12, 23]) throws correct exception}
  174     );
  175 
  176     throws_ok(    # TGIV007
  177         sub { gsl_matrix_to_string({}) },
  178         "/(EMAV02.*$mode_tagline)/",
  179         q{TGIV007 gsl_matrix_to_string({}) throws correct exception}
  180     );
  181 
  182     throws_ok(    # TGIV008
  183         sub { gsl_matrix_to_string({carter => 'chris', duchovny => 'david', anderson => 'gillian'}) },
  184         "/(EMAV02.*$mode_tagline)/",
  185         q{TGIV008 gsl_matrix_to_string({carter => 'chris', duchovny => 'david', anderson => 'gillian'}) throws correct exception}
  186     );
  187 
  188     throws_ok(    # TGIV009
  189         sub { gsl_matrix_to_string(RPerl::Test::Foo->new()) },
  190         "/(EMAV03.*$mode_tagline)/",
  191         q{TGIV009 gsl_matrix_to_string(RPerl::Test::Foo->new()) throws correct exception}
  192     );
  193 
  194     # NEED ANSWER: how to actually trigger EMAV04???
  195 #    throws_ok(    # TGIV010
  196 #        sub { gsl_matrix_to_string(Math::GSL::Matrix->new(1, 1)) },
  197 #        "/(EMAV04.*$mode_tagline)/",
  198 #        q{TGIV010 gsl_matrix_to_string(Math::GSL::Matrix->new(1, 1)) throws correct exception}
  199 #    );
  200 
  201     $number_of_tests_run += 10;
  202 
  203     # [[[ STRINGIFY TESTS ]]]
  204     # [[[ STRINGIFY TESTS ]]]
  205     # [[[ STRINGIFY TESTS ]]]
  206 
  207     throws_ok(    # TGIV500
  208         sub { gsl_matrix_to_string() },
  209         "/(EMAV00.*$mode_tagline)|(Usage.*gsl_matrix_to_string)/",    # DEV NOTE: 2 different error messages, RPerl & C
  210         q{TGIV500 gsl_matrix_to_string() throws correct exception}
  211     );
  212 
  213     throws_ok(                                                    # TGIV501
  214         sub { gsl_matrix_to_string(undef) },
  215         "/EMAV00.*$mode_tagline/",
  216         q{TGIV501 gsl_matrix_to_string(undef) throws correct exception}
  217     );
  218 
  219     throws_ok(                                                    # TGIV508
  220         sub { gsl_matrix_to_string( [3] ) },
  221         "/EMAV01.*$mode_tagline/",
  222         q{TGIV508 gsl_matrix_to_string([3]) throws correct exception}
  223     );
  224     throws_ok(                                                    # TGIV509
  225         sub { gsl_matrix_to_string( { a_key => 3 } ) },
  226         "/EMAV02.*$mode_tagline/",
  227         q{TGIV509 gsl_matrix_to_string({a_key => 3}) throws correct exception}
  228     );
  229 
  230     lives_and(                                                    # TGIV510
  231         sub {
  232             is( gsl_matrix_to_string(number_arrayref_to_gsl_matrix([0, 1, 2, 3], 2, 2)), '34_567_890', q{TGIV510 gsl_matrix_to_string(number_arrayref_to_gsl_matrix([0, 1, 2, 3], 2, 2)) returns correct value} );
  233         },
  234         q{TGIV510 gsl_matrix_to_string(number_arrayref_to_gsl_matrix([0, 1, 2, 3], 2, 2)) lives}
  235     );
  236 
  237 
  238     $number_of_tests_run += 17;
  239 
  240     # [[[ TYPE TESTING TESTS ]]]
  241     # [[[ TYPE TESTING TESTS ]]]
  242     # [[[ TYPE TESTING TESTS ]]]
  243  
  244     lives_and(                                                    # TGIV700
  245         sub {
  246             is( gsl_matrix_typetest0(), ( 3 + $mode_id ), q{TGIV700 gsl_matrix_typetest0() returns correct value} );
  247         },
  248         q{TGIV700 gsl_matrix_typetest0() lives}
  249     );
  250 
  251     $number_of_tests_run += 1;
  252 
  253     throws_ok(                                                    # TGIV610
  254         sub { gsl_matrix_typetest1() },
  255         "/(EMAV00.*$mode_tagline)|(Usage.*gsl_matrix_typetest1)/"
  256         ,                                                         # DEV NOTE: 2 different error messages, RPerl & C
  257         q{TGIV610 gsl_matrix_typetest1() throws correct exception}
  258     );
  259     throws_ok(                                                    # TGIV611
  260         sub { gsl_matrix_typetest1(undef) },
  261         "/EMAV00.*$mode_tagline/",
  262         q{TGIV611 gsl_matrix_typetest1(undef) throws correct exception}
  263     );
  264     lives_and(                                                    # TGIV612
  265         sub {
  266             is( gsl_matrix_typetest1(3), ( ( 3 * 2 ) + $mode_id ), q{TGIV612 gsl_matrix_typetest1(3) returns correct value} );
  267         },
  268         q{TGIV612 gsl_matrix_typetest1(3) lives}
  269     );
  270     lives_and(                                                    # TGIV613
  271         sub {
  272             is( gsl_matrix_typetest1(-17), ( ( -17 * 2 ) + $mode_id ), q{TGIV613 gsl_matrix_typetest1(-17) returns correct value} );
  273         },
  274         q{TGIV613 gsl_matrix_typetest1(-17) lives}
  275     );
  276     throws_ok(                                                    # TGIV614
  277         sub { gsl_matrix_typetest1(-17.3) },
  278         "/EMAV01.*$mode_tagline/",
  279         q{TGIV614 gsl_matrix_typetest1(-17.3) throws correct exception}
  280     );
  281     throws_ok(                                                    # TGIV615
  282         sub { gsl_matrix_typetest1('-17.3') },
  283         "/EMAV01.*$mode_tagline/",
  284         q{TGIV615 gsl_matrix_typetest1('-17.3') throws correct exception}
  285     );
  286     throws_ok(                                                    # TGIV616
  287         sub { gsl_matrix_typetest1( [3] ) },
  288         "/EMAV01.*$mode_tagline/",
  289         q{TGIV616 gsl_matrix_typetest1([3]) throws correct exception}
  290     );
  291     throws_ok(                                                    # TGIV617
  292         sub { gsl_matrix_typetest1( { a_key => 3 } ) },
  293         "/EMAV01.*$mode_tagline/",
  294         q{TGIV617 gsl_matrix_typetest1({a_key => 3}) throws correct exception}
  295     );
  296     lives_and(                                                    # TGIV618
  297         sub {
  298             is( gsl_matrix_typetest1(-234_567_890), ( ( -234_567_890 * 2 ) + $mode_id ), q{TGIV618 gsl_matrix_typetest1(-234_567_890) returns correct value} );
  299         },
  300         q{TGIV618 gsl_matrix_typetest1(-234_567_890) lives}
  301     );
  302     throws_ok(                                                    # TGIV619
  303         sub {
  304             gsl_matrix_typetest1(-1_234_567_890_000_000_000_000_000_000_000_000);
  305         },
  306         "/EMAV01.*$mode_tagline/",
  307         q{TGIV619 gsl_matrix_typetest1(-1_234_567_890_000_000_000_000_000_000_000_000) throws correct exception}
  308     );
  309 }
  310 
  311 done_testing($number_of_tests_run);