[libmarpa-r2-perl] 17/32: Allow override of libmarpa for testing

Jonas Smedegaard dr at jones.dk
Sat May 17 21:24:13 UTC 2014


This is an automated email from the git hooks/post-receive script.

js pushed a commit to annotated tag Marpa-R2-2.085_004
in repository libmarpa-r2-perl.

commit aa82b585a6bfd64206ed17e644077eac631ce995
Author: Jeffrey Kegler <JKEGL at cpan.org>
Date:   Fri Apr 25 16:10:28 2014 -0700

    Allow override of libmarpa for testing
---
 cpan/inc/Marpa/R2/Build_Me.pm |  8 ++++++--
 cpan/lib/Marpa/R2.pm          | 41 +++++++++++++++++++++++++++++++++++++++++
 cpan/t/00-load.t              |  1 +
 3 files changed, 48 insertions(+), 2 deletions(-)

diff --git a/cpan/inc/Marpa/R2/Build_Me.pm b/cpan/inc/Marpa/R2/Build_Me.pm
index 18063de..be36077 100644
--- a/cpan/inc/Marpa/R2/Build_Me.pm
+++ b/cpan/inc/Marpa/R2/Build_Me.pm
@@ -277,8 +277,9 @@ sub process_xs {
     File::Path::mkpath( $spec->{archdir}, 0, ( oct 777 ) )
         if not -d $spec->{archdir};
 
+    my $libmarpa_archive;
     FIND_LIBRARY: {
-        my $libmarpa_archive = $self->args('marpa-library');
+        $libmarpa_archive = $self->args('marpa-library');
         last FIND_LIBRARY if defined $libmarpa_archive;
         if ($Marpa::R2::USE_PERL_AUTOCONF) {
             my $libmarpa_libs_dir =
@@ -293,8 +294,8 @@ sub process_xs {
             '.libs' );
         $libmarpa_archive =
             File::Spec->catfile( $libmarpa_libs_dir, 'libmarpa.a' );
-        push @{ $self->{properties}->{objects} }, $libmarpa_archive;
     } ## end FIND_LIBRARY:
+    push @{ $self->{properties}->{objects} }, $libmarpa_archive;
 
     # .xs -> .bs
     $self->add_to_cleanup( $spec->{bs_file} );
@@ -790,6 +791,9 @@ sub ACTION_clean {
 
 sub ACTION_test {
     my $self = shift;
+    if (defined $self->args('marpa-library')) {
+        die q{"marpa-library" option not allowed with "test" target};
+    }
     local $ENV{PERL_DL_NONLAZY} = 1;
     return $self->SUPER::ACTION_test;
 }
diff --git a/cpan/lib/Marpa/R2.pm b/cpan/lib/Marpa/R2.pm
index 6d35abc..c68667c 100644
--- a/cpan/lib/Marpa/R2.pm
+++ b/cpan/lib/Marpa/R2.pm
@@ -34,6 +34,47 @@ use Marpa::R2::Version;
 
 $Marpa::R2::USING_XS = 1;
 $Marpa::R2::USING_PP = 0;
+$Marpa::R2::LIBMARPA_FILE = '[built-in]';
+
+LOAD_EXPLICIT_LIBRARY: {
+    last LOAD_EXPLICIT_LIBRARY if  not $ENV{'MARPA_AUTHOR_TEST'};
+    my $file = $ENV{MARPA_LIBRARY};
+    last LOAD_EXPLICIT_LIBRARY if  not $file;
+
+    require DynaLoader;
+    package DynaLoader;
+    my $bs = $file;
+    $bs =~ s/(\.\w+)?(;\d*)?$/\.bs/; # look for .bs 'beside' the library
+
+    if (-s $bs) { # only read file if it's not empty
+#       print STDERR "BS: $bs ($^O, $dlsrc)\n" if $dl_debug;
+        eval { do $bs; };
+        warn "$bs: $@\n" if $@;
+    }
+
+    my $bootname = "marpa_g_new";
+    @DynaLoader::dl_require_symbols = ($bootname);
+
+    my $libref = dl_load_file($file, 0) or do { 
+        require Carp;
+        Carp::croak("Can't load libmarpa library: '$file'" . dl_error());
+    };
+    push(@DynaLoader::dl_librefs,$libref);  # record loaded object
+
+    my @unresolved = dl_undef_symbols();
+    if (@unresolved) {
+        require Carp;
+        Carp::carp("Undefined symbols present after loading $file: @unresolved\n");
+    }
+
+    dl_find_symbol($libref, $bootname) or do {
+        require Carp;
+        Carp::croak("Can't find '$bootname' symbol in $file\n");
+    };
+
+    push(@DynaLoader::dl_shared_objects, $file); # record files loaded
+    $Marpa::R2::LIBMARPA_FILE = $file;
+}
 
 eval {
     require XSLoader;
diff --git a/cpan/t/00-load.t b/cpan/t/00-load.t
index be7732c..bfbe884 100644
--- a/cpan/t/00-load.t
+++ b/cpan/t/00-load.t
@@ -47,6 +47,7 @@ my $libmarpa_version_desc =
 Test::More::ok( $libmarpa_version_ok, $libmarpa_version_desc );
 
 Test::More::diag($marpa_string_version_desc);
+Test::More::diag('Libmarpa: ' . $Marpa::R2::LIBMARPA_FILE);
 Test::More::diag($libmarpa_version_desc);
 
 my $grammar;

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libmarpa-r2-perl.git



More information about the Pkg-perl-cvs-commits mailing list