File Coverage

blib/lib/RPerl/DataType/TypeInner.pm
Criterion Covered Total %
statement 15 15 100.0
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 20 20 100.0


line stmt bran cond sub pod time code
1             # [[[ HEADER ]]]
2             package RPerl::DataType::TypeInner;
3 4     4   25 use strict;
  4         13  
  4         104  
4 4     4   20 use warnings;
  4         10  
  4         88  
5 4     4   22 use RPerl::AfterSubclass;
  4         9  
  4         472  
6             our $VERSION = 0.002_200;
7              
8             # [[[ OO INHERITANCE ]]]
9 4     4   30 use parent qw(RPerl::GrammarRule);
  4         8  
  4         24  
10 4     4   206 use RPerl::GrammarRule;
  4         13  
  4         1933  
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             # [[[ OO PROPERTIES ]]]
17             our hashref $properties = {};
18              
19             # [[[ SUBROUTINES & OO METHODS ]]]
20              
21             our string_hashref::method $ast_to_rperl__generate = sub {
22             ( my object $self, my string_hashref $modes) = @_;
23             my string_hashref $rperl_source_group = { PMC => q{} };
24              
25             # RPerl::diag( 'in TypeInner->ast_to_rperl__generate(), received $self = ' . "\n" . RPerl::Parser::rperl_ast__dump($self) . "\n" );
26              
27             my string $self_class = ref $self;
28             if ( $self_class eq 'TypeInner_223' ) { # TypeInner -> MY Type '$TYPED_' OpStringOrWord OP19_VARIABLE_ASSIGN
29             my string $my = $self->{children}->[0];
30             my string $type = $self->{children}->[1]->{children}->[0];
31             my string $TYPED = $self->{children}->[2];
32             my string $name = $self->{children}->[3]->{children}->[0];
33              
34             # RPerl::diag( 'in TypeInner->ast_to_rperl__generate(), have $name = ' . "\n" . RPerl::Parser::rperl_ast__dump($name) . "\n" );
35            
36             $name =~ s/^(\w+)\s*$/$1/gxms; # strip trailing whitespace, caused by grammar matching operator names with trailing spaces
37             if ($name !~ /^[a-z]/) {
38             die 'ERROR ECOGEASRP25, CODE GENERATOR, ABSTRACT SYNTAX TO RPERL: invalid redundant name ' . q{'}
39             . $name . q{'}
40             . ' does not start with a lowercase letter a-z, dying' . "\n";
41             }
42             my string $equal = $self->{children}->[4];
43              
44             $rperl_source_group->{PMC} .= $my . q{ } . $type . q{ } . $TYPED . $name . q{ } . $equal . q{ };
45             }
46             else {
47             die RPerl::Parser::rperl_rule__replace(
48             'ERROR ECOGEASRP00, CODE GENERATOR, ABSTRACT SYNTAX TO RPERL: Grammar rule '
49             . $self_class
50             . ' found where TypeInner_223 expected, dying'
51             ) . "\n";
52             }
53              
54             return $rperl_source_group;
55             };
56              
57             our string_hashref::method $ast_to_cpp__generate__CPPOPS_PERLTYPES = sub {
58             ( my object $self, my string_hashref $modes) = @_;
59             my string_hashref $cpp_source_group
60             = { CPP => q{// <<< RP::DT::TI __DUMMY_SOURCE_CODE CPPOPS_PERLTYPES >>>}
61             . "\n" };
62              
63             #...
64             return $cpp_source_group;
65             };
66              
67             our string_hashref::method $ast_to_cpp__generate__CPPOPS_CPPTYPES = sub {
68             ( my object $self, my string_hashref $modes) = @_;
69             my string_hashref $cpp_source_group = {};
70              
71             # RPerl::diag( 'in TypeInner->ast_to_cpp__generate__CPPOPS_CPPTYPES(), received $self = ' . "\n" . RPerl::Parser::rperl_ast__dump($self) . "\n" );
72              
73             my string $self_class = ref $self;
74             if ( $self_class eq 'TypeInner_223' ) { # TypeInner -> MY Type '$TYPED_' WORD OP19_VARIABLE_ASSIGN
75             my string $type = $self->{children}->[1]->{children}->[0];
76             my string $name = $self->{children}->[3]->{children}->[0];
77             $name =~ s/^(\w+)\s*$/$1/gxms; # strip trailing whitespace, caused by grammar matching operator names with trailing spaces
78             if ($name !~ /^[a-z]/) {
79             die 'ERROR ECOGEASCP25, CODE GENERATOR, ABSTRACT SYNTAX TO C++: invalid redundant name ' . q{'}
80             . $name . q{'}
81             . ' does not start with a lowercase letter a-z, dying' . "\n";
82             }
83              
84             $cpp_source_group->{CPP} = $type;
85             }
86             else {
87             die RPerl::Parser::rperl_rule__replace(
88             'ERROR ECOGEASCP00, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Grammar rule '
89             . $self_class
90             . ' found where TypeInner_223 expected, dying'
91             ) . "\n";
92             }
93              
94             return $cpp_source_group;
95             };
96              
97             1; # end of class