File Coverage

blib/lib/RPerl/Operation/Statement/OperatorVoid/Named/Die.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             # [[[ HEADER ]]]
2             package RPerl::Operation::Statement::OperatorVoid::Named::Die;
3 5     5   31 use strict;
  5         11  
  5         131  
4 5     5   59 use warnings;
  5         17  
  5         136  
5 5     5   36 use RPerl::AfterSubclass;
  5         14  
  5         744  
6             our $VERSION = 0.003_000;
7              
8             # [[[ OO INHERITANCE ]]]
9             # NEED FIX: is not a Grammar Rule so should not inherit from OperatorVoid, need create Grammar Production class
10 5     5   37 use parent qw(RPerl::Operation::Statement::OperatorVoid::Named);
  5         14  
  5         30  
11 5     5   315 use RPerl::Operation::Statement::OperatorVoid::Named;
  5         14  
  5         146  
12              
13             # [[[ CRITICS ]]]
14             ## no critic qw(ProhibitUselessNoCritic ProhibitMagicNumbers RequireCheckedSyscalls) # USER DEFAULT 1: allow numeric values & print operator
15             ## no critic qw(RequireInterpolationOfMetachars) # USER DEFAULT 2: allow single-quoted control characters & sigils
16             ## no critic qw(ProhibitConstantPragma ProhibitMagicNumbers) # USER DEFAULT 3: allow constants
17              
18             # [[[ CONSTANTS ]]]
19 5     5   26 use constant NAME => my string $TYPED_NAME = 'die';
  5         21  
  5         281  
20              
21             # DEV NOTE: ARGUMENTS_MIN of 0 can be ignored, no such thing as negative number of args!
22 5     5   34 use constant ARGUMENTS_MIN => my integer $TYPED_ARGUMENTS_MIN = 0;
  5         13  
  5         240  
23 5     5   28 use constant ARGUMENTS_MAX => my integer $TYPED_ARGUMENTS_MAX = 999;
  5         12  
  5         2873  
24              
25             # [[[ OO PROPERTIES ]]]
26             our hashref $properties = {};
27              
28             # [[[ SUBROUTINES & OO METHODS ]]]
29              
30             our string_hashref::method $ast_to_rperl__generate = sub {
31             ( my object $self, my string_hashref $modes, my object $operator_void_named) = @_;
32             my string_hashref $rperl_source_group = { PMC => q{} };
33              
34             # RPerl::diag( 'in OperatorVoid::Named::Die->ast_to_rperl__generate(), received $self = ' . "\n" . RPerl::Parser::rperl_ast__dump($self) . "\n" );
35             # RPerl::diag( 'in OperatorVoid::Named::Die->ast_to_rperl__generate(), received $operator_void_named = ' . "\n" . RPerl::Parser::rperl_ast__dump($operator_void_named) . "\n" );
36              
37             if ( ref $operator_void_named eq 'OperatorVoid_119' ) { # OperatorVoid -> OP01_NAMED_VOID_SCOLON
38             $rperl_source_group->{PMC} .= $operator_void_named->{children}->[0]; # name semicolon
39             }
40             elsif ( ref $operator_void_named eq 'OperatorVoid_121' ) { # OperatorVoid -> OP01_NAMED_VOID ListElements ';'
41             $rperl_source_group->{PMC}
42             .= $operator_void_named->{children}->[0] . q{ }; # name
43             my object $arguments = $operator_void_named->{children}->[1];
44             my integer $argument_count = $arguments->length();
45             if ( $argument_count > ARGUMENTS_MAX() ) {
46             die 'ERROR ECOGEASRP03, CODE GENERATOR, ABSTRACT SYNTAX TO RPERL:' . "\n"
47             . 'Argument count '
48             . $argument_count
49             . ' exceeds maximum argument limit '
50             . ARGUMENTS_MAX()
51             . ' for operator ' . q{'}
52             . NAME() . q{'}
53             . ', dying' . "\n";
54             }
55             my string_hashref $rperl_source_subgroup = $arguments->ast_to_rperl__generate( $modes, $self );
56             RPerl::Generator::source_group_append( $rperl_source_group, $rperl_source_subgroup );
57             $rperl_source_group->{PMC} .= $operator_void_named->{children}->[2]; # semicolon
58             }
59             else {
60             die RPerl::Parser::rperl_rule__replace( 'ERROR ECOGEASRP00, CODE GENERATOR, ABSTRACT SYNTAX TO RPERL: Grammar rule '
61             . ( ref $operator_void_named )
62             . ' found where OperatorVoid_119 or OperatorVoid_121 expected, dying' )
63             . "\n";
64             }
65              
66             $rperl_source_group->{PMC} .= "\n";
67             return $rperl_source_group;
68             };
69              
70             our string_hashref::method $ast_to_cpp__generate__CPPOPS_PERLTYPES = sub {
71             ( my object $self, my string_hashref $modes, my object $operator_void_named) = @_;
72             my string_hashref $cpp_source_group = { CPP => q{// <<< RP::O::S::OV::N::D __DUMMY_SOURCE_CODE CPPOPS_PERLTYPES >>>} . "\n" };
73              
74             #...
75             return $cpp_source_group;
76             };
77              
78             our string_hashref::method $ast_to_cpp__generate__CPPOPS_CPPTYPES = sub {
79             ( my object $self, my string_hashref $modes, my object $operator_void_named) = @_;
80             my string_hashref $cpp_source_group = { CPP => q{} };
81              
82             # RPerl::diag( 'in OperatorVoid::Named::Die->ast_to_cpp__generate__CPPOPS_CPPTYPES(), received $self = ' . "\n" . RPerl::Parser::rperl_ast__dump($self) . "\n" );
83             # RPerl::diag( 'in OperatorVoid::Named::Die->ast_to_cpp__generate__CPPOPS_CPPTYPES(), received $operator_void_named = ' . "\n" . RPerl::Parser::rperl_ast__dump($operator_void_named) . "\n" );
84              
85             if ( ref $operator_void_named eq 'OperatorVoid_119' ) { # OperatorVoid -> OP01_NAMED_VOID_SCOLON
86             # DEV NOTE, CORRELATION #rp102: renamed from Perl die to C++ Die to avoid error redefining Perl's embed.h die
87             $cpp_source_group->{CPP} .= ucfirst $operator_void_named->{children}->[0]; # Name semicolon
88             }
89             elsif ( ref $operator_void_named eq 'OperatorVoid_121' ) { # OperatorVoid -> OP01_NAMED_VOID ListElements ';'
90             # DEV NOTE, CORRELATION #rp102: renamed from Perl die to C++ Die to avoid error redefining Perl's embed.h die
91             # DEV NOTE, CORRELATION #rp102a: C++ cerr w/ recursive variadic template and exit() is equivalent to Perl die, DISABLED
92             # DEV NOTE, CORRELATION #rp102b: C++ cerr w/ inlined exit() is equivalent to Perl die
93             $cpp_source_group->{CPP} .= ucfirst $operator_void_named->{children}->[0]; # Name
94             $cpp_source_group->{CPP} .= q{(}; # left parentheses, CORRELATION #rp102a
95             $cpp_source_group->{CPP} .= q{ };
96             my object $arguments = $operator_void_named->{children}->[1];
97             my integer $argument_count = $arguments->length();
98             if ( $argument_count > ARGUMENTS_MAX() ) {
99             die 'ERROR ECOGEASCP03, CODE GENERATOR, ABSTRACT SYNTAX TO C++:' . "\n"
100             . 'Argument count ' . $argument_count . ' exceeds maximum argument limit ' . ARGUMENTS_MAX()
101             . ' for operator ' . q{'} . NAME() . q{'} . ', dying' . "\n";
102             }
103              
104             # save to stack of saved flags, when needed
105             if ((exists $modes->{_inside_die_operator}) and (defined $modes->{_inside_die_operator})) {
106             if ((not exists $modes->{_inside_die_operator_saved}) or (not defined $modes->{_inside_die_operator_saved})) {
107             $modes->{_inside_die_operator_saved} = [];
108             }
109             push @{$modes->{_inside_die_operator_saved}}, $modes->{_inside_die_operator};
110             }
111             $modes->{_inside_die_operator} = 1;
112              
113             my string_hashref $cpp_source_subgroup = $arguments->ast_to_cpp__generate__CPPOPS_CPPTYPES( $modes, $self );
114             RPerl::Generator::source_group_append( $cpp_source_group, $cpp_source_subgroup );
115             $cpp_source_group->{CPP} .= q{ )}; # right parentheses, CORRELATION #rp102a
116             $cpp_source_group->{CPP} .= $operator_void_named->{children}->[2]; # semicolon
117             # $cpp_source_group->{CPP} .= ' exit(1);'; # inlined exit(), CORRELATION #rp102b
118              
119             # restore from stack of saved flags, when needed
120             delete $modes->{_inside_die_operator};
121             if ((exists $modes->{_inside_die_operator_saved}) and (defined $modes->{_inside_die_operator_saved}) and (scalar $modes->{_inside_die_operator_saved})) {
122             $modes->{_inside_die_operator} = pop @{$modes->{_inside_die_operator_saved}};
123             if (not scalar $modes->{_inside_die_operator_saved}) { delete $modes->{_inside_die_operator_saved}; }
124             }
125             }
126             else {
127             die RPerl::Parser::rperl_rule__replace( 'ERROR ECOGEASRP00, CODE GENERATOR, ABSTRACT SYNTAX TO RPERL: Grammar rule '
128             . ( ref $operator_void_named )
129             . ' found where OperatorVoid_119 or OperatorVoid_121 expected, dying' )
130             . "\n";
131             }
132              
133             $cpp_source_group->{CPP} .= "\n";
134             return $cpp_source_group;
135             };
136              
137             1; # end of class