File Coverage

blib/lib/RPerl/CompileUnit/Module/Package.pm
Criterion Covered Total %
statement 21 21 100.0
branch n/a
condition n/a
subroutine 7 7 100.0
pod n/a
total 28 28 100.0


line stmt bran cond sub pod time code
1             # [[[ HEADER ]]]
2             package RPerl::CompileUnit::Module::Package;
3 4     4   33 use strict;
  4         11  
  4         134  
4 4     4   21 use warnings;
  4         9  
  4         96  
5 4     4   24 use RPerl::AfterSubclass;
  4         11  
  4         516  
6             our $VERSION = 0.001_100;
7              
8             # [[[ OO INHERITANCE ]]]
9 4     4   32 use parent qw(RPerl::CompileUnit::Module);
  4         9  
  4         27  
10 4     4   262 use RPerl::CompileUnit::Module;
  4         14  
  4         80  
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              
16             # [[[ INCLUDES ]]]
17 4     4   23 use RPerl::Parser;
  4         11  
  4         131  
18 4     4   27 use RPerl::Generator;
  4         11  
  4         2127  
19              
20             # [[[ OO PROPERTIES ]]]
21             our hashref $properties = {};
22              
23             # [[[ SUBROUTINES & OO METHODS ]]]
24              
25             our string_hashref::method $ast_to_rperl__generate = sub {
26             ( my object $self, my string $package_name_underscores, my string_hashref $modes ) = @_;
27             my string_hashref $rperl_source_group = {};
28              
29             # RPerl::diag( 'in Package->ast_to_rperl__generate(), received $self = ' . "\n" . RPerl::Parser::rperl_ast__dump($self) . "\n" );
30              
31             my string $self_class = ref $self;
32              
33             # unwrap Package_34 from Module_24
34             if ( ($self_class) eq 'Module_24' ) {
35             $self = $self->{children}->[0];
36             $self_class = ref $self;
37             }
38              
39             if ( ($self_class) ne 'Package_34' ) {
40             die RPerl::Parser::rperl_rule__replace(
41             'ERROR ECOGEASRP00, CODE GENERATOR, ABSTRACT SYNTAX TO RPERL: Grammar rule '
42             . ($self_class)
43             . ' found where Module_24 or Package_34 expected, dying' )
44             . "\n";
45             }
46              
47             # Package: Critic* Include* Constant* Subroutine+ LITERAL_NUMBER ';' ;
48             # Package -> STAR-10 STAR-11 STAR-12 PLUS-13 LITERAL_NUMBER ';'
49             my object $critic_star = $self->{children}->[0];
50             my object $include_star = $self->{children}->[1];
51             my object $constant_star = $self->{children}->[2];
52             my object $subroutine_plus = $self->{children}->[3];
53             my string $retval_literal_number = $self->{children}->[4];
54             my string $retval_semicolon = $self->{children}->[5];
55              
56             my string_hashref $rperl_source_subgroup;
57              
58             if ( exists $critic_star->{children}->[0] ) {
59             if ( $modes->{label} eq 'ON' ) {
60             $rperl_source_group->{PMC} .= '# [[[ CRITICS ]]]' . "\n";
61             }
62             }
63             foreach my object $critic ( @{ $critic_star->{children} } ) {
64             $rperl_source_subgroup = $critic->ast_to_rperl__generate($modes);
65             RPerl::Generator::source_group_append( $rperl_source_group,
66             $rperl_source_subgroup );
67             }
68              
69             if ( exists $include_star->{children}->[0] ) {
70             if ( $modes->{label} eq 'ON' ) {
71             $rperl_source_group->{PMC} .= "\n" . '# [[[ INCLUDES ]]]' . "\n";
72             }
73             }
74             foreach my object $include ( @{ $include_star->{children} } ) { ## no critic qw(ProhibitPostfixControls) # SYSTEM SPECIAL 6: PERL CRITIC FILED ISSUE #639, not postfix foreach or if
75             $rperl_source_subgroup = $include->ast_to_rperl__generate($modes);
76             RPerl::Generator::source_group_append( $rperl_source_group,
77             $rperl_source_subgroup );
78             }
79              
80             if ( exists $constant_star->{children}->[0] ) {
81             if ( $modes->{label} eq 'ON' ) {
82             $rperl_source_group->{PMC} .= "\n" . '# [[[ CONSTANTS ]]]' . "\n";
83             }
84             }
85             foreach my object $constant ( @{ $constant_star->{children} } ) { ## no critic qw(ProhibitPostfixControls) # SYSTEM SPECIAL 6: PERL CRITIC FILED ISSUE #639, not postfix foreach or if
86             $rperl_source_subgroup = $constant->ast_to_rperl__generate($modes);
87             RPerl::Generator::source_group_append( $rperl_source_group,
88             $rperl_source_subgroup );
89             }
90              
91             # always have at least one subroutine, don't need to check if they exist to label
92             if ( $modes->{label} eq 'ON' ) {
93             $rperl_source_group->{PMC} .= "\n" . '# [[[ SUBROUTINES ]]]' . "\n";
94             }
95             foreach my object $subroutine ( ## no critic qw(ProhibitPostfixControls) # SYSTEM SPECIAL 6: PERL CRITIC FILED ISSUE #639, not postfix foreach or if
96             @{ $subroutine_plus->{children} }
97             )
98             {
99             $rperl_source_subgroup
100             = $subroutine->ast_to_rperl__generate($modes);
101             RPerl::Generator::source_group_append( $rperl_source_group,
102             $rperl_source_subgroup );
103             }
104              
105             if ( $modes->{label} eq 'ON' ) {
106             $rperl_source_group->{PMC}
107             .= "\n"
108             . $retval_literal_number
109             . $retval_semicolon
110             . ' # end of package' . "\n";
111             }
112             else {
113             $rperl_source_group->{PMC}
114             .= $retval_literal_number . $retval_semicolon . "\n";
115             }
116              
117             return $rperl_source_group;
118             };
119              
120             our string_hashref::method $ast_to_cpp__generate__CPPOPS_PERLTYPES = sub {
121             ( my object $self, my string $package_name_underscores, my string_hashref $modes ) = @_;
122             my string_hashref $cpp_source_group = {
123             CPP =>
124             q{// <<< RP::CU::M::P __DUMMY_SOURCE_CODE CPPOPS_PERLTYPES >>>}
125             . "\n",
126             H => q{// <<< RP::CU::M::P __DUMMY_SOURCE_CODE CPPOPS_PERLTYPES >>>}
127             . "\n",
128             # PMC => q{# <<< RP::CU::M::P __DUMMY_SOURCE_CODE CPPOPS_PERLTYPES >>>} . "\n"
129             };
130              
131             #...
132             return $cpp_source_group;
133             };
134              
135             our string_hashref::method $ast_to_cpp__generate__CPPOPS_CPPTYPES = sub {
136             ( my object $self, my string $package_name_underscores, my string_hashref $modes ) = @_;
137             my string_hashref $cpp_source_group = {
138             CPP => q{// <<< RP::CU::M::P __DUMMY_SOURCE_CODE CPPOPS_CPPTYPES >>>}
139             . "\n",
140             H => q{// <<< RP::CU::M::P __DUMMY_SOURCE_CODE CPPOPS_CPPTYPES >>>}
141             . "\n",
142             # PMC => q{# <<< RP::CU::M::P __DUMMY_SOURCE_CODE CPPOPS_CPPTYPES >>>} . "\n"
143             };
144              
145             #...
146             return $cpp_source_group;
147             };
148              
149             1; # end of class