File Coverage

blib/lib/Marpa/R2.pm
Criterion Covered Total %
statement 42 59 71.1
branch 6 16 37.5
condition 0 3 0.0
subroutine 12 15 80.0
pod 0 2 0.0
total 60 95 63.1


line stmt bran cond sub pod time code
1             # Copyright 2022 Jeffrey Kegler
2             # This file is part of Marpa::R2. Marpa::R2 is free software: you can
3             # redistribute it and/or modify it under the terms of the GNU Lesser
4             # General Public License as published by the Free Software Foundation,
5             # either version 3 of the License, or (at your option) any later version.
6             #
7             # Marpa::R2 is distributed in the hope that it will be useful,
8             # but WITHOUT ANY WARRANTY; without even the implied warranty of
9             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
10             # Lesser General Public License for more details.
11             #
12             # You should have received a copy of the GNU Lesser
13             # General Public License along with Marpa::R2. If not, see
14             # http://www.gnu.org/licenses/.
15              
16             package Marpa::R2;
17              
18 135     135   1194953 use 5.010001;
  135         601  
19 135     135   737 use strict;
  135         295  
  135         2806  
20 135     135   821 use warnings;
  135         309  
  135         4401  
21              
22 135     135   761 use vars qw($VERSION $STRING_VERSION @ISA $DEBUG);
  135         279  
  135         15340  
23             $VERSION = '13.002_000';
24             $STRING_VERSION = $VERSION;
25             ## no critic (BuiltinFunctions::ProhibitStringyEval)
26             $VERSION = eval $VERSION;
27             ## use critic
28             $DEBUG = 0;
29              
30 135     135   1012 use Carp;
  135         336  
  135         9297  
31 135     135   26310 use English qw( -no_match_vars );
  135         189045  
  135         976  
32 135     135   50953 use XSLoader;
  135         315  
  135         3658  
33              
34 135     135   58415 use Marpa::R2::Version;
  135         364  
  135         65699  
35              
36             $Marpa::R2::USING_XS = 1;
37             $Marpa::R2::USING_PP = 0;
38             $Marpa::R2::LIBMARPA_FILE = '[built-in]';
39              
40             LOAD_EXPLICIT_LIBRARY: {
41             last LOAD_EXPLICIT_LIBRARY if not $ENV{'MARPA_AUTHOR_TEST'};
42             my $file = $ENV{MARPA_LIBRARY};
43             last LOAD_EXPLICIT_LIBRARY if not $file;
44              
45             require DynaLoader;
46             package DynaLoader;
47             my $bs = $file;
48             $bs =~ s/(\.\w+)?(;\d*)?$/\.bs/; # look for .bs 'beside' the library
49              
50             if (-s $bs) { # only read file if it's not empty
51             # print STDERR "BS: $bs ($^O, $dlsrc)\n" if $dl_debug;
52             eval { do $bs; };
53             warn "$bs: $@\n" if $@;
54             }
55              
56             my $bootname = "marpa_g_new";
57             @DynaLoader::dl_require_symbols = ($bootname);
58              
59             my $libref = dl_load_file($file, 0) or do {
60             require Carp;
61             Carp::croak("Can't load libmarpa library: '$file'" . dl_error());
62             };
63             push(@DynaLoader::dl_librefs,$libref); # record loaded object
64              
65             my @unresolved = dl_undef_symbols();
66             if (@unresolved) {
67             require Carp;
68             Carp::carp("Undefined symbols present after loading $file: @unresolved\n");
69             }
70              
71             dl_find_symbol($libref, $bootname) or do {
72             require Carp;
73             Carp::croak("Can't find '$bootname' symbol in $file\n");
74             };
75              
76             push(@DynaLoader::dl_shared_objects, $file); # record files loaded
77             $Marpa::R2::LIBMARPA_FILE = $file;
78             }
79              
80             XSLoader::load( 'Marpa::R2', $Marpa::R2::STRING_VERSION );
81              
82             if ( not $ENV{'MARPA_AUTHOR_TEST'} ) {
83             $Marpa::R2::DEBUG = 0;
84             }
85             else {
86             Marpa::R2::Thin::debug_level_set(1);
87             $Marpa::R2::DEBUG = 1;
88             }
89              
90             sub version_ok {
91 1350     1350 0 3782 my ($sub_module_version) = @_;
92 1350 50       4462 return 'not defined' if not defined $sub_module_version;
93 1350 50       4129 return "$sub_module_version does not match Marpa::R2::VERSION " . $VERSION
94             if $sub_module_version != $VERSION;
95 1350         6312 return;
96             } ## end sub version_ok
97              
98             # Set up the error values
99             my @error_names = Marpa::R2::Thin::error_names();
100             for ( my $error = 0; $error <= $#error_names; ) {
101             my $current_error = $error;
102             (my $name = $error_names[$error] ) =~ s/\A MARPA_ERR_//xms;
103 135     135   1112 no strict 'refs';
  135         352  
  135         75760  
104             *{ "Marpa::R2::Error::$name" } = \$current_error;
105             # This shuts up the "used only once" warning
106             my $dummy = eval q{$} . 'Marpa::R2::Error::' . $name;
107             $error++;
108             }
109              
110             my $version_result;
111             require Marpa::R2::Internal;
112             ( $version_result = version_ok($Marpa::R2::Internal::VERSION) )
113             and die 'Marpa::R2::Internal::VERSION ', $version_result;
114              
115             require Marpa::R2::Grammar;
116             ( $version_result = version_ok($Marpa::R2::Grammar::VERSION) )
117             and die 'Marpa::R2::Grammar::VERSION ', $version_result;
118              
119             require Marpa::R2::Recognizer;
120             ( $version_result = version_ok($Marpa::R2::Recognizer::VERSION) )
121             and die 'Marpa::R2::Recognizer::VERSION ', $version_result;
122              
123             require Marpa::R2::Value;
124             ( $version_result = version_ok($Marpa::R2::Value::VERSION) )
125             and die 'Marpa::R2::Value::VERSION ', $version_result;
126              
127             require Marpa::R2::MetaG;
128             ( $version_result = version_ok($Marpa::R2::MetaG::VERSION) )
129             and die 'Marpa::R2::MetaG::VERSION ', $version_result;
130              
131             require Marpa::R2::SLG;
132             ( $version_result = version_ok($Marpa::R2::Scanless::G::VERSION) )
133             and die 'Marpa::R2::Scanless::G::VERSION ', $version_result;
134              
135             require Marpa::R2::SLR;
136             ( $version_result = version_ok($Marpa::R2::Scanless::R::VERSION) )
137             and die 'Marpa::R2::Scanless::R::VERSION ', $version_result;
138              
139             require Marpa::R2::MetaAST;
140             ( $version_result = version_ok($Marpa::R2::MetaAST::VERSION) )
141             and die 'Marpa::R2::MetaAST::VERSION ', $version_result;
142              
143             require Marpa::R2::Stuifzand;
144             ( $version_result = version_ok($Marpa::R2::Stuifzand::VERSION) )
145             and die 'Marpa::R2::Stuifzand::VERSION ', $version_result;
146              
147             require Marpa::R2::ASF;
148             ( $version_result = version_ok($Marpa::R2::ASF::VERSION) )
149             and die 'Marpa::R2::ASF::VERSION ', $version_result;
150              
151             sub Marpa::R2::exception {
152 45     45 0 201 my $exception = join q{}, @_;
153 45         872 $exception =~ s/ \n* \z /\n/xms;
154 45 50       161 die($exception) if $Marpa::R2::JUST_DIE;
155 45         115 CALLER: for ( my $i = 0; 1; $i++) {
156 163         995 my ($package ) = caller($i);
157 163 50       468 last CALLER if not $package;
158 163 100       433 last CALLER if not 'Marpa::R2::' eq substr $package, 0, 11;
159 118         275 $Carp::Internal{ $package } = 1;
160             }
161 45         6885 Carp::croak($exception, q{Marpa::R2 exception});
162             }
163              
164             package Marpa::R2::Internal::X;
165              
166             use overload (
167             q{""} => sub {
168 0     0   0 my ($self) = @_;
169 0   0     0 return $self->{message} // $self->{fallback_message};
170             },
171 135         1272 fallback => 1
172 135     135   167390 );
  135         135092  
173              
174             sub new {
175 0     0     my ( $class, @hash_ref_args ) = @_;
176 0           my %x_object = ();
177 0           for my $hash_ref_arg (@hash_ref_args) {
178 0 0         if ( ref $hash_ref_arg ne "HASH" ) {
179 0           my $ref_type = ref $hash_ref_arg;
180 0 0         my $ref_desc = $ref_type ? "ref to $ref_type" : "not a ref";
181 0           die
182             "Internal error: args to Marpa::R2::Internal::X->new is $ref_desc -- it should be hash ref";
183             } ## end if ( ref $hash_ref_arg ne "HASH" )
184 0           $x_object{$_} = $hash_ref_arg->{$_} for keys %{$hash_ref_arg};
  0            
185             } ## end for my $hash_ref_arg (@hash_ref_args)
186 0           my $name = $x_object{name};
187 0 0         die("Internal error: an excepion must have a name") if not $name;
188 0           $x_object{fallback_message} = qq{Exception "$name" thrown};
189 0           return bless \%x_object, $class;
190             } ## end sub new
191              
192             sub name {
193 0     0     my ($self) = @_;
194 0           return $self->{name};
195             }
196              
197             1;
198              
199             # vim: set expandtab shiftwidth=4: