File Coverage

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