xref: /openbsd-src/gnu/usr.bin/perl/cpan/ExtUtils-MakeMaker/t/04-xs-rpath-darwin.t (revision 256a93a44f36679bee503f12e49566c2183f6181) 
1#!/usr/bin/perl -w
2
3# This test file tests a special case for the generation of XS modules on OS darwin.
4#  More specifically, it tests if we are able to compile an XS module which refers
5#  to another shared library in a non-standard location such that we can
6#  load the XS module from a perl script without having to set the
7#  DYLD_LIBRARY_PATH environment variable. See PR #403 and issue #402.
8#
9package Main;
10use strict;
11use warnings;
12use Config;
13BEGIN {
14    chdir 't' or die "chdir(t): $!\n";
15    unshift @INC, 'lib/';
16    use Test::More;
17    if( $^O ne "darwin" ) {
18        plan skip_all => 'Not darwin platform';
19    }
20    else {
21        plan skip_all => 'Dynaloading not enabled'
22            if !$Config{usedl} or $Config{usedl} ne 'define';
23        plan tests => 1;
24    }
25}
26use Cwd;
27use ExtUtils::MakeMaker;
28use File::Temp qw[tempdir];
29use File::Path;  # exports: mkpath and rmtree
30use File::Spec;
31
32{
33    $| = 1;
34    # We need this when re-running "perl Makefile.PL"
35    my $ext_utils_lib_dir = File::Spec->rel2abs('../lib');
36    # This tmpdir will be removed when the program exits
37    my $tmpdir = tempdir( DIR => '.', CLEANUP => 1 );
38    my $cwd = getcwd;
39    # File::Temp will not clean up the temp directory if the current directory
40    #   is a sub directory of the temp dir. This can happen in the case of an
41    #   error (a call to die). which disrupts the normal program flow that would
42    #   have restored the cwd before exit. To solve this issue
43    #   we add the below END block (which will be called before the File::Temp
44    #   cleanup END block call since END blocks are called in LIFO order)
45    END { chdir $cwd }
46    _chdir($tmpdir);
47    my $self = Main->new(
48        mylib_dir => "mylib",
49        mylib_c_fn => "mylib.c",
50        mylib_h_fn => "mylib.h",
51        mylib_lib_name => "mylib",
52        module_name => "My::Module",
53        test_script_name => 'p.pl',
54        ext_utils_lib_dir => $ext_utils_lib_dir,
55    );
56    $self->compile_library();
57    $self->write_makefile_pl();
58    $self->write_module_file();
59    $self->write_xs_file();
60    $self->run_make();
61    $self->write_test_script();
62    $self->run_test_script();
63    _chdir($cwd);
64}
65
66sub _chdir { chdir $_[0] or die "Cannot change directory to $_[0] : $!" }
67
68sub _mkpath { mkpath($_[0]) or die "Could not create directory $_[0] : $!" };
69
70sub run_test_script {
71    my ($self) = @_;
72
73    my @cmd = ($^X, '-Mblib', $self->{test_script_name});
74    my $out = _capture_stdout(\@cmd);
75    like( $out, qr{\Qcalling foo()\E\s+\QHello from foo()\E});
76}
77
78sub write_xs_file {
79    my ($self) = @_;
80
81    my $str = <<'END';
82#include "EXTERN.h"
83#include "perl.h"
84#include "XSUB.h"
85#include "mylib.h"
86
87MODULE = <<module_name_colon>>  PACKAGE = <<module_name_colon>>
88PROTOTYPES: DISABLE
89
90void
91mylib_func()
92  CODE:
93    printf("calling foo()\n");
94    foo();
95END
96    $str =~ s/\Q<<module_name_colon>>\E/$self->{module_name}/g;
97    my @module_name = split /::/, $self->{module_name};
98    my $xs_name = pop @module_name;
99    $xs_name .= '.xs';
100    _write_file( $xs_name, $str );
101}
102
103sub write_test_script {
104    my ($self) = @_;
105
106    my $str = <<'END';
107use strict;
108use warnings;
109use ExtUtils::testlib;
110use <<module_name_colon>>;
111
112<<module_name_colon>>::mylib_func();
113END
114    $str =~ s/\Q<<module_name_colon>>\E/$self->{module_name}/g;
115    _write_file( $self->{test_script_name}, $str );
116}
117
118sub run_make {
119    my ($self) = @_;
120
121    my @cmd = ($^X, '-I'. $self->{ext_utils_lib_dir}, 'Makefile.PL');
122    _run_system_cmd(\@cmd);
123    _run_system_cmd(['make']);
124}
125
126sub write_module_file {
127    my ( $self ) = @_;
128
129    my @dirs = split /::/, $self->{module_name};
130    my $basename = pop @dirs;
131    my $dir = File::Spec->catfile('lib', @dirs);
132    _mkpath( $dir );
133    my $fn = File::Spec->catfile($dir, $basename . '.pm');
134    my $str = <<'END';
135package <<module_name_colon>>;
136require Exporter;
137require DynaLoader;
138$VERSION = 1.01;
139@ISA    = qw(Exporter DynaLoader);
140@EXPORT = qw();
141bootstrap <<module_name_colon>> $VERSION;
1421;
143
144=head1 NAME
145
146<<module_name_colon>> - Short description of <<module_name_colon>>
147END
148    $str =~ s/\Q<<module_name_colon>>\E/$self->{module_name}/g;
149    _write_file( $fn, $str );
150}
151
152sub write_makefile_pl {
153    my ( $self ) = @_;
154
155    my $str = <<'END';
156use strict;
157use warnings;
158use ExtUtils::MakeMaker;
159
160WriteMakefile(
161  NAME          => '<<module_name_colon>>',
162  VERSION_FROM  => 'lib/<<module_name_slash>>.pm',
163  ABSTRACT_FROM => 'lib/<<module_name_slash>>.pm',
164  PERL          => "$^X -w",
165  LIBS          => ['-L./<<lib_dir>> -l<<lib_name>>'],
166  INC           => '-I. -I./<<lib_dir>>',
167);
168END
169    my $mod_name1 = $self->{module_name};
170    my $mod_name2 = $self->{module_name};
171    $mod_name2 =~ s{::}{/}g;
172    $str =~ s/\Q<<module_name_colon>>\E/$mod_name1/g;
173    $str =~ s/\Q<<module_name_slash>>\E/$mod_name2/g;
174    $str =~ s/\Q<<lib_dir>>\E/$self->{mylib_dir}/g;
175    $str =~ s/\Q<<lib_name>>\E/$self->{mylib_lib_name}/g;
176    _write_file('Makefile.PL', $str);
177}
178
179sub compile_library {
180    my ($self) = @_;
181
182    _mkpath( $self->{mylib_dir} );
183    my $cwd = getcwd;
184    _chdir( $self->{mylib_dir} );
185    $self->write_mylib_h();
186    $self->write_mylib_c();
187    $self->compile_mylib();
188    _chdir( $cwd );
189}
190
191sub compile_mylib {
192    my ($self) = @_;
193
194    my $cc = $Config{cc};
195    my $libext = $Config{so};
196
197    my $libname = 'lib' . $self->{mylib_lib_name} . '.' . $libext;
198    my @cmd = ($cc, '-I.', '-dynamiclib', '-install_name',
199             '@rpath/' . $libname,
200             'mylib.c', '-o', $libname);
201    _run_system_cmd(\@cmd);
202}
203
204sub _capture_stdout {
205    my ($cmd) = @_;
206
207    my $out = `@$cmd`;
208    _check_sys_cmd_error( $cmd, $? ) if $? != 0;
209    return $out;
210}
211
212sub _stringify_cmd { '"' . (join " ", @{$_[0]}) . '"' }
213
214sub _check_sys_cmd_error {
215    my ( $cmd, $error ) = @_;
216    my $cmd_str = _stringify_cmd($cmd);
217    if ( $error == -1 ) {
218        # A return value of -1 from system() indicates a failure to start the program
219        die "Could not run $cmd_str: $!";
220    }
221    elsif ($error & 127) {
222        die sprintf "Command $cmd_str : killed by signal %d, %s coredump\n",
223          ($error & 127),  ($error & 128) ? 'with' : 'without';
224    }
225    elsif ($error != 0) {
226        die sprintf "$cmd_str exited with error code %d\n", $error >> 8;
227    }
228}
229
230sub _run_system_cmd {
231    my ($cmd) = @_;
232
233    my $res = system @$cmd;
234    _check_sys_cmd_error( $cmd, $res ) if $res != 0;
235
236}
237
238sub write_mylib_c {
239    my ($self) = @_;
240    my $str = <<'END';
241#include <stdio.h>
242#include <stdlib.h>
243#include "mylib.h"
244
245void foo() {
246    printf( "Hello from foo()\n");
247}
248END
249    _write_file($self->{mylib_c_fn}, $str);
250}
251
252sub write_mylib_h {
253    my ($self) = @_;
254    my $str = 'void foo();';
255    _write_file($self->{mylib_h_fn}, $str);
256}
257
258sub _write_file {
259    my ($file, $text) = @_;
260    my $utf8 = ("$]" < 5.008 or !$Config{useperlio}) ? "" : ":utf8";
261    open(FILE, ">$utf8", $file) || die "Can't create $file: $!";
262    print FILE $text;
263    close FILE;
264}
265
266sub new {
267    my ($class, %args) = @_;
268    return bless \%args, $class;
269}
270