File Coverage

blib/lib/RPerl/CodeBlock.pm
Criterion Covered Total %
statement 36 36 100.0
branch n/a
condition n/a
subroutine 12 12 100.0
pod n/a
total 48 48 100.0


line stmt bran cond sub pod time code
1             # [[[ HEADER ]]]
2             package RPerl::CodeBlock;
3 9     9   3378 use strict;
  9         20  
  9         215  
4 9     9   42 use warnings;
  9         19  
  9         180  
5 9     9   44 use RPerl::AfterSubclass;
  9         17  
  9         1053  
6             our $VERSION = 0.004_000;
7              
8             # [[[ OO INHERITANCE ]]]
9 9     9   61 use parent qw(RPerl::GrammarRule);
  9         19  
  9         76  
10 9     9   312 use RPerl::GrammarRule;
  9         20  
  9         5029  
11              
12             # [[[ CRITICS ]]]
13             ## no critic qw(ProhibitUselessNoCritic ProhibitMagicNumbers RequireCheckedSyscalls) # USER DEFAULT 1: allow numeric values & print operator
14             ## no critic qw(RequireInterpolationOfMetachars) # USER DEFAULT 2: allow single-quoted control characters & sigils
15             ## no critic qw(Capitalization ProhibitMultiplePackages ProhibitReusedNames) # SYSTEM DEFAULT 3: allow multiple & lower case package names
16              
17             # [[[ OO PROPERTIES ]]]
18             our hashref $properties = {};
19              
20             # [[[ SUBROUTINES & OO METHODS ]]]
21              
22             our string_hashref::method $ast_to_rperl__generate = sub {
23             ( my object $self, my string_hashref $modes) = @_;
24             my string_hashref $rperl_source_group = { PMC => q{} };
25              
26             # RPerl::diag( 'in CodeBlock->ast_to_rperl__generate(), received $self = ' . "\n" . RPerl::Parser::rperl_ast__dump($self) . "\n" );
27              
28             my string $self_class = ref $self;
29              
30             if ( $self_class eq 'CodeBlock_174' ) { # CodeBlock -> LBRACE PLUS-41 '}'
31             my string $left_brace = $self->{children}->[0];
32             my object $operation_plus = $self->{children}->[1];
33             my string $right_brace = $self->{children}->[2];
34              
35             $rperl_source_group->{PMC} .= $left_brace . "\n";
36              
37             foreach my object $operation ( @{ $operation_plus->{children} } ) {
38             my object $rperl_source_subgroup = $operation->ast_to_rperl__generate($modes);
39             RPerl::Generator::source_group_append( $rperl_source_group, $rperl_source_subgroup );
40              
41             # $rperl_source_group->{PMC} .= "\n";
42             }
43              
44             $rperl_source_group->{PMC} .= $right_brace . "\n";
45             }
46             else {
47             die RPerl::Parser::rperl_rule__replace(
48             'ERROR ECOGEASRP00, CODE GENERATOR, ABSTRACT SYNTAX TO RPERL: Grammar rule ' . $self_class . ' found where CodeBlock_174 expected, dying' )
49             . "\n";
50             }
51             return $rperl_source_group;
52             };
53              
54             our string_hashref::method $ast_to_cpp__generate__CPPOPS_PERLTYPES = sub {
55             ( my object $self, my string $loop_label, my string_hashref $modes) = @_;
56             my string_hashref $cpp_source_group = { CPP => q{// <<< RP::CB __DUMMY_SOURCE_CODE CPPOPS_PERLTYPES >>>} . "\n" };
57              
58             #...
59             return $cpp_source_group;
60             };
61              
62             our string_hashref::method $ast_to_cpp__generate__CPPOPS_CPPTYPES = sub {
63             ( my object $self, my string $loop_label, my string_hashref $modes) = @_;
64             my string_hashref $cpp_source_group = { CPP => q{} };
65              
66             # RPerl::diag( 'in CodeBlock->ast_to_cpp__generate__CPPOPS_CPPTYPES(), received $self = ' . "\n" . RPerl::Parser::rperl_ast__dump($self) . "\n" );
67             # RPerl::diag( 'in CodeBlock->ast_to_cpp__generate__CPPOPS_CPPTYPES(), received $loop_label = ' . "\n" . RPerl::Parser::rperl_ast__dump($loop_label) . "\n" );
68             # RPerl::diag( 'in CodeBlock->ast_to_cpp__generate__CPPOPS_CPPTYPES(), received $modes->{_inside_parallel_loop} = ' . "\n" . $modes->{_inside_parallel_loop} . "\n" );
69             # RPerl::diag( 'in CodeBlock->ast_to_cpp__generate__CPPOPS_CPPTYPES(), received $modes->{_current_parallel_loop} = ' . "\n" . Dumper($modes->{_current_parallel_loop}) . "\n" );
70            
71             my string $self_class = ref $self;
72              
73             if ( $self_class eq 'CodeBlock_174' ) { # CodeBlock -> LBRACE PLUS-41 '}'
74             my string $left_brace = $self->{children}->[0];
75             my object $operation_plus = $self->{children}->[1];
76             my string $right_brace = $self->{children}->[2];
77              
78             $cpp_source_group->{CPP} .= $left_brace . "\n";
79             # NEED FIX PARALLEL: temporarily disabled loop control labels while inside parallel loop to avoid pluto polycc error
80             # RPerl::diag( 'in CodeBlock->ast_to_cpp__generate__CPPOPS_CPPTYPES(), before _REDO, have $modes->{_inside_parallel_loop} = ' . "\n" . RPerl::Parser::rperl_ast__dump($modes->{_inside_parallel_loop}) . "\n" );
81             if (( defined $loop_label ) and
82             not ((exists $modes->{_inside_parallel_loop}) and (defined $modes->{_inside_parallel_loop}) and $modes->{_inside_parallel_loop})) {
83             $cpp_source_group->{CPP} .= $loop_label . '_REDO: 1;' . "\n";
84             }
85              
86             foreach my object $operation ( @{ $operation_plus->{children} } ) {
87             # RPerl::diag( 'in CodeBlock->ast_to_cpp__generate__CPPOPS_CPPTYPES(), have $operation = ' . "\n" . RPerl::Parser::rperl_ast__dump($operation) . "\n" );
88             my object $cpp_source_subgroup = $operation->ast_to_cpp__generate__CPPOPS_CPPTYPES($modes);
89             RPerl::Generator::source_group_append( $cpp_source_group, $cpp_source_subgroup );
90             }
91            
92             # DEV NOTE, INLINE BUG: must include '1;' null statement after labels to avoid the following error messages during g++ call from 'Running Mkbootstrap' Inline phase
93             # error: expected primary-expression before ‘}’ token
94             # error: expected ‘;’ before ‘}’ token
95             # NEED FIX PARALLEL: temporarily disabled loop control labels while inside parallel loop to avoid pluto polycc error
96             # RPerl::diag( 'in CodeBlock->ast_to_cpp__generate__CPPOPS_CPPTYPES(), before _NEXT, have $modes->{_inside_parallel_loop} = ' . "\n" . RPerl::Parser::rperl_ast__dump($modes->{_inside_parallel_loop}) . "\n" );
97             if (( defined $loop_label ) and
98             not ((exists $modes->{_inside_parallel_loop}) and (defined $modes->{_inside_parallel_loop}) and $modes->{_inside_parallel_loop})) {
99             $cpp_source_group->{CPP} .= $loop_label . '_NEXT: 1;' . "\n";
100             }
101              
102             $cpp_source_group->{CPP} .= $right_brace . "\n";
103              
104             # RPerl::diag( 'in CodeBlock->ast_to_cpp__generate__CPPOPS_CPPTYPES(), before _LAST, have $modes->{_inside_parallel_loop} = ' . "\n" . RPerl::Parser::rperl_ast__dump($modes->{_inside_parallel_loop}) . "\n" );
105             if (( defined $loop_label ) and
106             not ((exists $modes->{_inside_parallel_loop}) and (defined $modes->{_inside_parallel_loop}) and $modes->{_inside_parallel_loop})) {
107             $cpp_source_group->{CPP} .= $loop_label . '_LAST: 1;' . "\n";
108             }
109             }
110             else {
111             die RPerl::Parser::rperl_rule__replace(
112             'ERROR ECOGEASCP00, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Grammar rule ' . $self_class . ' found where CodeBlock_174 expected, dying' )
113             . "\n";
114             }
115             return $cpp_source_group;
116             };
117              
118             # [[[ SUB-TYPES ]]]
119              
120             package RPerl::CodeReference;
121 9     9   69 use strict;
  9         24  
  9         196  
122 9     9   44 use warnings;
  9         18  
  9         295  
123 9     9   46 use parent qw(RPerl::DataType::Modifier::Reference);
  9         19  
  9         41  
124 9     9   541 use RPerl::DataType::Modifier::Reference;
  9         18  
  9         244  
125              
126             package # hide from PAUSE indexing
127             coderef;
128 9     9   53 use strict;
  9         20  
  9         184  
129 9     9   42 use warnings;
  9         22  
  9         258  
130 9     9   44 use parent -norequire, qw(RPerl::CodeReference);
  9         18  
  9         48  
131              
132             1; # end of class