File Coverage

blib/lib/MarpaX/Languages/ECMAScript/AST/Util.pm
Criterion Covered Total %
statement 18 74 24.3
branch 0 14 0.0
condition 0 12 0.0
subroutine 6 15 40.0
pod 8 8 100.0
total 32 123 26.0


line stmt bran cond sub pod time code
1 1     1   4 use strict;
  1         1  
  1         33  
2 1     1   4 use warnings FATAL => 'all';
  1         1  
  1         39  
3              
4             package MarpaX::Languages::ECMAScript::AST::Util;
5              
6             # ABSTRACT: ECMAScript Translation to AST - Class method utilities
7              
8 1     1   5 use Exporter 'import';
  1         1  
  1         32  
9 1     1   4 use Log::Any qw/$log/;
  1         1  
  1         7  
10 1     1   53 use Data::Dumper;
  1         2  
  1         156  
11             # Marpa follows Unicode recommendation, i.e. perl's \R, that cannot be in a character class
12             our $NEWLINE_REGEXP = qr/(?>\x0D\x0A|\v)/;
13              
14             our $VERSION = '0.019'; # VERSION
15             # CONTRIBUTORS
16              
17             our @EXPORT_OK = qw/whoami whowasi traceAndUnpack showLineAndCol lineAndCol lastCompleted startAndLength lastLexemeSpan/;
18             our %EXPORT_TAGS = ('all' => [ @EXPORT_OK ]);
19              
20              
21             sub _cutbase {
22 0     0     my ($rc, $base) = @_;
23 1 0 0 1   474 if (defined($base) && "$base" && index($rc, "${base}::") == $[) {
  1   0     277  
  1         605  
  0            
24 0           substr($rc, $[, length($base) + 2, '');
25             }
26 0           return $rc;
27             }
28              
29             sub whoami {
30 0     0 1   return _cutbase((caller(1))[3], @_);
31             }
32              
33              
34             sub whowasi {
35 0     0 1   return _cutbase((caller(2))[3], @_);
36             }
37              
38              
39             sub traceAndUnpack {
40 0     0 1   my $nameOfArgumentsp = shift;
41              
42 0           my $whowasi = whowasi();
43 0           my @string = ();
44 0           my $min1 = scalar(@{$nameOfArgumentsp});
  0            
45 0           my $min2 = scalar(@_);
46 0 0         my $min = ($min1 < $min2) ? $min1 : $min2;
47 0           my $rc = {};
48 0           foreach (0..--$min) {
49 0           my ($key, $value) = ($nameOfArgumentsp->[$_], $_[$_]);
50 0           my $string = Data::Dumper->new([$value], [$key])->Indent(0)->Sortkeys(1)->Quotekeys(0)->Terse(0)->Dump();
51 0           $rc->{$key} = $value;
52             #
53             # Remove the ';'
54             #
55 0           substr($string, -1, 1, '');
56 0           push(@string, $string);
57             }
58             #
59             # Skip MarpaX::Languages::ECMAScript::AST::if any
60             #
61 0           $whowasi =~ s/^MarpaX::Languages::ECMAScript::AST:://;
62 0           $log->tracef('%s(%s)', $whowasi, join(', ', @string));
63 0           return($rc);
64             }
65              
66              
67             sub showLineAndCol {
68 0     0 1   my ($line, $col, $source) = @_;
69              
70 0 0         my $pointer = ($col > 0 ? '-' x ($col-1) : '') . '^';
71 0           my $content = '';
72              
73 0           my $prevpos = pos($source);
74 0           pos($source) = undef;
75 0           my $thisline = 0;
76 0           my $nbnewlines = 0;
77 0           my $eos = 0;
78 0           while ($source =~ m/\G(.*?)($NEWLINE_REGEXP|\Z)/scmg) {
79 0 0         if (++$thisline == $line) {
80 0           $content = substr($source, $-[1], $+[1] - $-[1]);
81 0 0         $eos = (($+[2] - $-[2]) > 0) ? 0 : 1;
82 0           last;
83             }
84             }
85 0           $content =~ s/\t/ /g;
86 0 0         if ($content) {
87 0           $nbnewlines = (substr($source, 0, pos($source)) =~ tr/\n//);
88 0 0         if ($eos) {
89 0           ++$nbnewlines; # End of string instead of $NEWLINE_REGEXP
90             }
91             }
92 0           pos($source) = $prevpos;
93              
94 0           return "line:column $line:$col (Unicode newline count) $nbnewlines:$col (\\n count)\n\n$content\n$pointer";
95             }
96              
97              
98             sub lineAndCol {
99 0     0 1   my ($impl, $g1) = @_;
100              
101 0   0       $g1 //= $impl->current_g1_location();
102 0           my ($start, $length) = $impl->g1_location_to_span($g1);
103 0           my ($line, $column) = $impl->line_column($start);
104 0           return [ $line, $column ];
105             }
106              
107              
108             sub startAndLength {
109 0     0 1   my ($impl, $g1) = @_;
110              
111 0   0       $g1 //= $impl->current_g1_location();
112 0           my ($start, $length) = $impl->g1_location_to_span($g1);
113 0           return [ $start, $length ];
114             }
115              
116              
117             sub lastCompleted {
118 0     0 1   my ($impl, $symbol) = @_;
119 0           return $impl->substring($impl->last_completed($symbol));
120             }
121              
122              
123             sub lastLexemeSpan {
124 0     0 1   my ($impl) = @_;
125 0           return $impl->g1_location_to_span($impl->current_g1_location());
126             }
127              
128             1;
129              
130             __END__