File Coverage

blib/lib/RPerl/Operation/Expression/Operator/Named/Push.pm
Criterion Covered Total %
statement 24 24 100.0
branch n/a
condition n/a
subroutine 8 8 100.0
pod n/a
total 32 32 100.0


line stmt bran cond sub pod time code
1             # [[[ DOCUMENTATION ]]]
2             # http://perldoc.perl.org/functions/push.html
3             # SUPPORTED: push ARRAY, LIST
4              
5             # [[[ HEADER ]]]
6             package RPerl::Operation::Expression::Operator::Named::Push;
7 5     5   30 use strict;
  5         11  
  5         131  
8 5     5   24 use warnings;
  5         13  
  5         105  
9 5     5   26 use RPerl::AfterSubclass;
  5         11  
  5         595  
10             our $VERSION = 0.002_100;
11              
12             # [[[ OO INHERITANCE ]]]
13 5     5   33 use parent qw(RPerl::Operation::Expression::Operator::Named);
  5         12  
  5         31  
14 5     5   327 use RPerl::Operation::Expression::Operator::Named;
  5         14  
  5         148  
15              
16             # [[[ CRITICS ]]]
17             ## no critic qw(ProhibitUselessNoCritic ProhibitMagicNumbers RequireCheckedSyscalls) # USER DEFAULT 1: allow numeric values & print operator
18             ## no critic qw(RequireInterpolationOfMetachars) # USER DEFAULT 2: allow single-quoted control characters & sigils
19             ## no critic qw(ProhibitConstantPragma ProhibitMagicNumbers) # USER DEFAULT 3: allow constants
20              
21             # [[[ CONSTANTS ]]]
22 5     5   26 use constant NAME => my string $TYPED_NAME = 'push';
  5         11  
  5         276  
23 5     5   28 use constant ARGUMENTS_MIN => my integer $TYPED_ARGUMENTS_MIN = 2;
  5         12  
  5         239  
24 5     5   37 use constant ARGUMENTS_MAX => my integer $TYPED_ARGUMENTS_MAX = 999;
  5         12  
  5         3198  
25              
26             # [[[ OO PROPERTIES ]]]
27             our hashref $properties = {};
28              
29             # [[[ SUBROUTINES & OO METHODS ]]]
30              
31             our string_hashref::method $ast_to_rperl__generate = sub {
32             ( my object $self, my object $operator_named, my string_hashref $modes)
33             = @_;
34             my string_hashref $rperl_source_group = { PMC => q{} };
35              
36             # RPerl::diag( 'in Operator::Named::Push->ast_to_rperl__generate(), received $self = ' . "\n" . RPerl::Parser::rperl_ast__dump($self) . "\n" );
37             # RPerl::diag( 'in Operator::Named::Push->ast_to_rperl__generate(), received $operator_named = ' . "\n" . RPerl::Parser::rperl_ast__dump($operator_named) . "\n" );
38              
39             my string $operator_named_class = ref $operator_named;
40             if ( $operator_named_class eq 'Operation_79' ) { # Operation -> OP01_NAMED_SCOLON
41             die RPerl::Parser::rperl_rule__replace(
42             'ERROR ECOGEASRP18, CODE GENERATOR, ABSTRACT SYNTAX TO RPERL: Named operator '
43             . $operator_named->{children}->[0]
44             . ' requires multiple arguments, dying' )
45             . "\n";
46             }
47             elsif ( $operator_named_class eq 'Operator_83' ) { # Operator -> OP01_NAMED SubExpression
48             die RPerl::Parser::rperl_rule__replace(
49             'ERROR ECOGEASRP18, CODE GENERATOR, ABSTRACT SYNTAX TO RPERL: Named operator '
50             . $operator_named->{children}->[0]
51             . ' requires multiple arguments, dying' )
52             . "\n";
53             }
54             elsif ( $operator_named_class eq 'Operator_84' ) { # Operator -> LPAREN OP01_NAMED ListElement OP21_LIST_COMMA ListElements ')'
55             my string $left_paren = $operator_named->{children}->[0];
56             my string $operator_name = $operator_named->{children}->[1];
57             my object $argument0 = $operator_named->{children}->[2];
58             my string $list_comma = $operator_named->{children}->[3];
59             my object $arguments = $operator_named->{children}->[4];
60             my string $right_paren = $operator_named->{children}->[5];
61              
62             my integer $argument_count = $arguments->length() + 1;
63             if ( $argument_count < ARGUMENTS_MIN() ) {
64             die
65             'ERROR ECOGEASRP02, CODE GENERATOR, ABSTRACT SYNTAX TO RPERL:'
66             . "\n"
67             . 'Argument count '
68             . $argument_count
69             . ' falls below minimum argument limit '
70             . ARGUMENTS_MIN()
71             . ' for operation ' . q{'}
72             . NAME() . q{'}
73             . ', dying' . "\n";
74             }
75             if ( $argument_count > ARGUMENTS_MAX() ) {
76             die
77             'ERROR ECOGEASRP03, CODE GENERATOR, ABSTRACT SYNTAX TO RPERL:'
78             . "\n"
79             . 'Argument count '
80             . $argument_count
81             . ' exceeds maximum argument limit '
82             . ARGUMENTS_MAX()
83             . ' for operation ' . q{'}
84             . NAME() . q{'}
85             . ', dying' . "\n";
86             }
87              
88             $rperl_source_group->{PMC} .= $left_paren . q{ } . $operator_name . q{ };
89             my string_hashref $rperl_source_subgroup = $argument0->ast_to_rperl__generate( $modes, $self );
90             RPerl::Generator::source_group_append( $rperl_source_group, $rperl_source_subgroup );
91             $rperl_source_group->{PMC} .= $list_comma . q{ };
92             $rperl_source_subgroup = $arguments->ast_to_rperl__generate( $modes, $self );
93             RPerl::Generator::source_group_append( $rperl_source_group, $rperl_source_subgroup );
94             $rperl_source_group->{PMC} .= q{ } . $right_paren;
95             }
96             elsif ( $operator_named_class eq 'OperatorVoid_122' ) { # OperatorVoid -> OP01_NAMED ListElement OP21_LIST_COMMA ListElements ';'
97             my string $operator_name = $operator_named->{children}->[0];
98             my object $argument0 = $operator_named->{children}->[1];
99             my string $list_comma = $operator_named->{children}->[2];
100             my object $arguments = $operator_named->{children}->[3];
101             my string $semicolon = $operator_named->{children}->[4];
102              
103             my integer $argument_count = $arguments->length() + 1;
104             if ( $argument_count < ARGUMENTS_MIN() ) {
105             die
106             'ERROR ECOGEASRP02, CODE GENERATOR, ABSTRACT SYNTAX TO RPERL:'
107             . "\n"
108             . 'Argument count '
109             . $argument_count
110             . ' falls below minimum argument limit '
111             . ARGUMENTS_MIN()
112             . ' for operation ' . q{'}
113             . NAME() . q{'}
114             . ', dying' . "\n";
115             }
116             if ( $argument_count > ARGUMENTS_MAX() ) {
117             die
118             'ERROR ECOGEASRP03, CODE GENERATOR, ABSTRACT SYNTAX TO RPERL:'
119             . "\n"
120             . 'Argument count '
121             . $argument_count
122             . ' exceeds maximum argument limit '
123             . ARGUMENTS_MAX()
124             . ' for operation ' . q{'}
125             . NAME() . q{'}
126             . ', dying' . "\n";
127             }
128              
129             $rperl_source_group->{PMC} .= $operator_name . q{ };
130             my string_hashref $rperl_source_subgroup = $argument0->ast_to_rperl__generate( $modes, $self );
131             RPerl::Generator::source_group_append( $rperl_source_group, $rperl_source_subgroup );
132             $rperl_source_group->{PMC} .= $list_comma . q{ };
133             $rperl_source_subgroup = $arguments->ast_to_rperl__generate( $modes, $self );
134             RPerl::Generator::source_group_append( $rperl_source_group, $rperl_source_subgroup );
135             $rperl_source_group->{PMC} .= $semicolon . "\n";
136             }
137             else {
138             die RPerl::Parser::rperl_rule__replace(
139             'ERROR ECOGEASRP00, CODE GENERATOR, ABSTRACT SYNTAX TO RPERL: Grammar rule '
140             . ($operator_named_class)
141             . ' found where Operation_79, Operator_83, Operator_84, or OperatorVoid_122 expected, dying'
142             ) . "\n";
143             }
144              
145             return $rperl_source_group;
146             };
147              
148             our string_hashref::method $ast_to_cpp__generate__CPPOPS_PERLTYPES = sub {
149             ( my object $self, my string_hashref $modes) = @_;
150             my string_hashref $cpp_source_group
151             = { CPP =>
152             q{// <<< RP::O::E::O::N::Pu __DUMMY_SOURCE_CODE CPPOPS_PERLTYPES >>>}
153             . "\n" };
154              
155             #...
156             return $cpp_source_group;
157             };
158              
159             our string_hashref::method $ast_to_cpp__generate__CPPOPS_CPPTYPES = sub {
160             ( my object $self, my string_hashref $modes) = @_;
161             my string_hashref $cpp_source_group
162             = { CPP =>
163             q{// <<< RP::O::E::O::N::Pu __DUMMY_SOURCE_CODE CPPOPS_CPPTYPES >>>}
164             . "\n" };
165              
166             #...
167             return $cpp_source_group;
168             };
169              
170             1; # end of class