"Fossies" - the Fresh Open Source Software Archive

Member "RPerl-5.002000/t/12_parse.t" (30 Aug 2019, 11928 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 "12_parse.t": 4.001000_vs_4.002000.

    1 #!/usr/bin/env perl  ## no critic qw(ProhibitExcessMainComplexity)  # SYSTEM SPECIAL 4: allow complex code outside subroutines, must be on line 1
    2 
    3 # [[[ PRE-HEADER ]]]
    4 # suppress 'WEXRP00: Found multiple rperl executables' due to blib/ & pre-existing installation(s),
    5 # also 'WARNING WCOCODE00, COMPILER, FIND DEPENDENCIES: Failed to eval-use package' due to RPerl/Test/*/*Bad*.pm & RPerl/Test/*/*bad*.pl
    6 BEGIN { $ENV{RPERL_WARNINGS} = 0; }
    7 
    8 # [[[ HEADER ]]]
    9 use strict;
   10 use warnings;
   11 use RPerl::AfterSubclass;
   12 our $VERSION = 0.021_000;
   13 
   14 # [[[ CRITICS ]]]
   15 ## no critic qw(ProhibitUselessNoCritic ProhibitMagicNumbers RequireCheckedSyscalls)  # USER DEFAULT 1: allow numeric values & print operator
   16 ## no critic qw(RequireBriefOpen)  # USER DEFAULT 5: allow open() in perltidy-expanded code
   17 ## no critic qw(RequireInterpolationOfMetachars)  # USER DEFAULT 2: allow single-quoted control characters & sigils
   18 ## no critic qw(ProhibitDeepNests)  # SYSTEM SPECIAL 7: allow deeply-nested code
   19 
   20 # [[[ INCLUDES ]]]
   21 #use FooPerl
   22 use RPerl::Parser;
   23 use RPerl::Generator;
   24 use RPerl::Compiler;
   25 use Test::More;
   26 use Test::Exception;
   27 use File::Find qw(find);
   28 use English;  # $EVAL_ERROR not defined after moving RPerl::* into lives_and() tests in BEGIN block below
   29 use Cwd;
   30 use File::Spec;
   31 
   32 # [[[ CONSTANTS ]]]
   33 use constant PATH_TESTS => my string $TYPED_PATH_TESTS = $RPerl::INCLUDE_PATH . '/RPerl/Test';
   34 use constant PATH_TESTS_MYCLASS => my string $TYPED_PATH_TESTS_MYCLASS = $RPerl::INCLUDE_PATH . '/MyClass_Good.pm';
   35 
   36 # [[[ OPERATIONS ]]]
   37 our $verbose_newline = q{};
   38 if ( $ENV{RPERL_VERBOSE} or $RPerl::VERBOSE ) {
   39     $verbose_newline = "\n";
   40 }
   41 
   42 BEGIN {
   43     if ( $ENV{RPERL_VERBOSE} or $RPerl::VERBOSE ) {
   44         Test::More::diag("[[[ Beginning Parser Pre-Test Loading, RPerl Compilation System ]]]");
   45     }
   46     # DEV NOTE: can't do use_ok() or require_ok() because it will place them before all other BEGIN blocks,
   47     # which means we wil have 4 tests passing before we call 'plan tests',
   48     # which means we will fail to have 'plan tests' first OR done_testing() last, which causes a TAP failure;
   49     # must be included w/ regular 'use' operators above
   50 #    lives_and( sub { use_ok('RPerl::AfterSubclass'); },            q{use_ok('RPerl::AfterSubclass') lives} );
   51 #    lives_and( sub { use_ok('RPerl::Parser'); }, q{use_ok('RPerl::Parser') lives} );
   52 #    lives_and( sub { use_ok('RPerl::Generator'); }, q{use_ok('RPerl::Generator') lives} );
   53 #    lives_and( sub { use_ok('RPerl::Compiler'); }, q{use_ok('RPerl::Compiler') lives} );
   54 }
   55 
   56 # DEV NOTE: must specify number of tests in EITHER 'plan tests' or done_testing() below, not both
   57 #my integer $number_of_tests_run = 4;  # initialize to 4 for use_ok() calls in BEGIN block above
   58 
   59 my $test_files = {};    # string_hashref
   60 
   61 # NEED UPDATE: use 'no_chdir => 1' like 13_generate.t
   62 # save current directory for file checks, because File::Find changes directory;
   63 # use File::Spec for MS Windows support, etc.
   64 my $current_working_directory = getcwd;
   65 (my $volume, my $directories, my $dummy_file) = File::Spec->splitpath( $current_working_directory, 1 );  # no_file = 1
   66 
   67 sub find_tests {
   68     ( my string $file_full_path_arg ) = @ARG;
   69     
   70     # accept optional argument with pre-defined file path if provided, else fall back to File::Find
   71     my string $file_full_path;
   72     if (defined $file_full_path_arg) {
   73         $file_full_path = $file_full_path_arg;
   74     }
   75     else {
   76         $file_full_path = $File::Find::name;
   77     }
   78 
   79 #    RPerl::diag('in 12_parse.t, have $file_full_path = ' . $file_full_path . "\n");
   80 
   81 =DISABLE_REPLACED_BY_nochdir
   82     if (defined $ARGV[0]) {
   83         # restore saved path, because File::Find changes directories while searching for files
   84         my $file_full_path = File::Spec->catpath( $volume, $directories, $file );
   85 #        RPerl::diag('in 12_parse.t, have $file_full_path = ' . $file_full_path . "\n");
   86         $file = $file_full_path;
   87     }
   88 =cut
   89 
   90 #    if ( $file_full_path !~ m/.*Header\/program_00_bad_00.*[.]p[lm]$/xms ) { # TEMP DEBUGGING, ONLY FIND CERTAIN FILES
   91 #    if ( $file_full_path !~ m/.*Operator12CompareEqualNotEqual\/\w+[.]p[lm]$/xms ) { # TEMP DEBUGGING, ONLY FIND CERTAIN DIRECTORY
   92     if ( $file_full_path !~ m/.p[lm]$/xms ) {  # FIND ALL TEST FILES
   93         return;
   94     }
   95 
   96     if ( ( $file_full_path =~ m/Good/ms ) or ( $file_full_path =~ m/good/ms ) ) {
   97         $test_files->{$file_full_path} = undef;
   98 
   99         # check for existence of PARSE preprocessor directive, skip file if parsing is explicitly disabled, <<< PARSE: OFF >>>
  100         open my filehandleref $FILE_HANDLE, '<', $file_full_path
  101             or croak 'ERROR, Cannot open file ' . $file_full_path . ' for reading,' . $OS_ERROR . ', croaking';
  102         while (<$FILE_HANDLE>) {
  103             if (m/^\#\s*\<\<\<\s*PARSE\s*\:\s*OFF\s*\>\>\>/xms) {
  104                 delete $test_files->{$file_full_path};
  105                 last;
  106             }
  107         }
  108         close $FILE_HANDLE
  109             or croak 'ERROR, Cannot close file ' . $file_full_path . ' after reading,' . $OS_ERROR . ', croaking';
  110     }
  111     elsif ( ( $file_full_path =~ m/Bad/ms ) or ( $file_full_path =~ m/bad/ms ) ) {
  112         # check for existence of PARSE & PARSE_ERROR preprocessor directives, compile list of expected parse errors, <<< PARSE_ERROR: 'FOO' >>>
  113         open my filehandleref $FILE_HANDLE, '<', $file_full_path
  114             or croak 'ERROR, Cannot open file ' . $file_full_path . ' for reading,' . $OS_ERROR . ', croaking';
  115         while (<$FILE_HANDLE>) {
  116             if (m/^\#\s*\<\<\<\s*PARSE\s*\:\s*OFF\s*\>\>\>/xms) {
  117                 delete $test_files->{$file_full_path};
  118                 last;
  119             }
  120             if (m/^\#\s*\<\<\<\s*PARSE_ERROR\s*\:\s*['"](.*)['"]\s*\>\>\>/xms) {
  121                 push @{ $test_files->{$file_full_path}->{errors} }, $1;
  122             }
  123         }
  124         close $FILE_HANDLE
  125             or croak 'ERROR, Cannot close file ' . $file_full_path . ' after reading,' . $OS_ERROR . ', croaking';
  126     }
  127     else {  # file named neither Good nor Bad
  128         # check for existence of PARSE preprocessor directive, do NOT skip file if parsing is explicitly enabled, <<< PARSE: ON >>>
  129         open my filehandleref $FILE_HANDLE, '<', $file_full_path
  130             or croak 'ERROR, Cannot open file ' . $file_full_path . ' for reading,' . $OS_ERROR . ', croaking';
  131         while (<$FILE_HANDLE>) {
  132             if (m/^\#\s*\<\<\<\s*PARSE\s*\:\s*ON\s*\>\>\>/xms) {
  133                 $test_files->{$file_full_path} = undef;
  134                 last;
  135             }
  136         }
  137         close $FILE_HANDLE
  138             or croak 'ERROR, Cannot close file ' . $file_full_path . ' after reading,' . $OS_ERROR . ', croaking';
  139     }
  140 }
  141 
  142 find(
  143     {
  144         no_chdir => 1,  # if not set, causes incorrect paths when $ARGV[0] is defined
  145         wanted => \&find_tests
  146     },
  147     (defined $ARGV[0]) ? $ARGV[0] : PATH_TESTS()  # accept optional command-line argument
  148 );
  149 
  150 if (not defined $ARGV[0]) {
  151     # locate _MyClass.pm w/out unnecessary additional searching
  152     find_tests(PATH_TESTS_MYCLASS());
  153 }
  154 
  155 # trim unnecessary (and possibly problematic) absolute paths from input file names
  156 # must be done outside find() to properly utilize getcwd()
  157 foreach my string $test_file_key (sort keys %{$test_files}) {
  158     my string $test_file_key_trimmed = RPerl::Compiler::post_processor__absolute_path_delete($test_file_key);
  159     if ($test_file_key_trimmed ne $test_file_key) {
  160         $test_files->{$test_file_key_trimmed} = $test_files->{$test_file_key};
  161         delete $test_files->{$test_file_key};
  162     }
  163 }
  164 
  165 my integer $number_of_test_files = scalar keys %{$test_files};
  166 
  167 #RPerl::diag( 'in 12_parse.t, have $test_files = ' . "\n" . Dumper($test_files) . "\n" );
  168 #RPerl::diag( 'in 12_parse.t, have sort keys %{$test_files} = ' . "\n" . Dumper(sort keys %{$test_files}) . "\n" );
  169 #RPerl::diag( 'in 12_parse.t, have $number_of_test_files = ' . $number_of_test_files . "\n" );
  170 
  171 plan tests => $number_of_test_files;
  172 
  173 if ( $ENV{RPERL_VERBOSE} ) {
  174     Test::More::diag( '[[[ Beginning Parser Tests, RPerl Compilation System' . ' ]]]' );
  175 }
  176 
  177 # [[[ PRIMARY RUNLOOP ]]]
  178 # [[[ PRIMARY RUNLOOP ]]]
  179 # [[[ PRIMARY RUNLOOP ]]]
  180 
  181 for my $test_file ( sort keys %{$test_files} ) {
  182 #    RPerl::diag( 'in 12_parse.t, have $test_file = ' . $test_file . "\n" );
  183     ( my string $rperl_input_file_name, my string_hashref $cpp_output_file_name_group, my string_hashref $cpp_source_group, my string_hashref $modes ) = @ARG;
  184 
  185     # NEED UPGRADE: enable file dependencies as in script/rperl depends_parse_generate_save_subcompile_execute()
  186     my $eval_return_value = eval {
  187         RPerl::Compiler::rperl_to_xsbinary__parse_generate_compile(
  188             $test_file,
  189             undef,    # empty $cpp_output_file_name_group, no files will be saved in PARSE mode
  190             {},       # empty $cpp_source_group, starting compile process from scratch, not continued
  191             {   
  192 #                dependencies => 'OFF',  # unnecessary
  193                 ops     => 'PERL',
  194                 types   => 'PERL',
  195 #                check        => 'TRACE',    # unnecessary
  196                 uncompile    => 'OFF',
  197                 compile => 'PARSE',
  198 #                subcompile   => 'OFF',  # unnecessary
  199 #                CXX          => 'g++',  # unnecessary
  200                 parallel => 'OFF',
  201 #                execute => 'OFF',  # unnecessary
  202 #                label   => 'OFF'   # unnecessary
  203             }
  204         );    # returns void
  205         1;    # return true
  206     };
  207 
  208 #    RPerl::diag( 'in 12_parse.t, have $eval_return_value = ' . $eval_return_value . "\n" );  # warning if undef retval
  209 
  210     if ( ( defined $eval_return_value ) and $eval_return_value ) {    # Perl eval return code defined & true, success
  211         if ( ( $test_file =~ m/Bad/xms ) or ( $test_file =~ m/bad/xms ) ) {
  212             ok( 0, 'Program or module parses with errors:' . (q{ } x 13) . $test_file );
  213 #            $number_of_tests_run++;
  214         }
  215         else {
  216             ok( 1, 'Program or module parses without errors:' . (q{ } x 10) . $test_file );
  217 #            $number_of_tests_run++;
  218         }
  219     }
  220     else {                                                            # Perl eval return code undefined or false, error
  221         print $verbose_newline;
  222 
  223 #        RPerl::diag( "\n\n\n" . 'in 12_parse.t, have $EVAL_ERROR = ' . $EVAL_ERROR . "\n\n\n" );
  224         if ( ( $test_file =~ m/Bad/ms ) or ( $test_file =~ m/bad/ms ) ) {
  225 #            RPerl::diag( 'in 12_parse.t, have BAD $test_file = ' . $test_file . "\n" );
  226             my $missing_errors = [];
  227             if ( defined $test_files->{$test_file}->{errors} ) {
  228                 foreach my $error ( @{ $test_files->{$test_file}->{errors} } ) {
  229 #                    RPerl::diag('in 12_parse.t, have $error = ' . $error . "\n" );
  230                     # DEV NOTE: debug to show which tests trigger a Helpful Hint
  231 #                    if ( $EVAL_ERROR =~ /Helpful\ Hint/xms ) {
  232 #                        print '[[[ YES HELPFUL HINT ' . $test_file . ' ]]]' . "\n\n";
  233 #                    }
  234                     
  235                     if ( $EVAL_ERROR !~ /\Q$error\E/xms ) {
  236                         push @{$missing_errors}, "Error message '$error' expected, but not found";
  237                     }
  238                 }
  239             }
  240             ok( ( ( scalar @{$missing_errors} ) == 0 ), 'Program or module parses with expected error(s):' . (q{ } x 2) . $test_file );
  241             if (( scalar @{$missing_errors} ) != 0) {
  242                 diag((join "\n", @{$missing_errors}) . "\n");
  243             }
  244 #            $number_of_tests_run++;
  245         }
  246         else {
  247             ok( 0, 'Program or module parses without errors:' . (q{ } x 10) . $test_file );
  248             diag('Error output captured:' . "\n" . $EVAL_ERROR);
  249 #            $number_of_tests_run++;
  250         }
  251     }
  252 }
  253 
  254 #RPerl::diag( 'in 12_parse.t, have $number_of_tests_run =' . $number_of_tests_run . "\n" );
  255 
  256 done_testing();
  257 #done_testing($number_of_tests_run);