xref: /openbsd/gnu/usr.bin/perl/lib/ExtUtils/t/Embed.t (revision 771fbea0) 
1#!/usr/bin/perl
2
3BEGIN {
4    if( $ENV{PERL_CORE} ) {
5        chdir 't' if -d 't';
6        @INC = '../lib';
7    }
8}
9chdir 't';
10
11use Config;
12use ExtUtils::Embed;
13use File::Spec;
14use IPC::Cmd qw(can_run);
15
16my $cc = $Config{'cc'};
17if ( $Config{usecrosscompile} && !can_run($cc) ) {
18    print "1..0 # SKIP Cross-compiling and the target doesn't have $cc";
19    exit;
20}
21
22if (ord("A") != 65) {
23    print "1..0 # SKIP EBCDIC platform doesn't currently work";
24    exit;
25}
26open(my $fh,">embed_test.c") || die "Cannot open embed_test.c:$!";
27print $fh <DATA>;
28close($fh);
29
30$| = 1;
31print "1..10\n";
32
33my $cl  = ($^O eq 'MSWin32' && $cc eq 'cl');
34my $skip_exe = $^O eq 'os2' && $Config{ldflags} =~ /(?<!\S)-Zexe\b/;
35my $exe = 'embed_test';
36$exe .= $Config{'exe_ext'} unless $skip_exe;	# Linker will auto-append it
37my $obj = 'embed_test' . $Config{'obj_ext'};
38my $inc = File::Spec->updir;
39my $lib = File::Spec->updir;
40my $libperl_copied;
41my $testlib;
42my @cmd;
43my (@cmd2) if $^O eq 'VMS';
44# Don't use ccopts() here as we may want to overwrite an existing
45# perl with a new one with inconsistent header files, meaning
46# the usual value for perl_inc(), which is used by ccopts(),
47# will be wrong.
48if ($^O eq 'VMS') {
49    push(@cmd,$cc,"/Obj=$obj");
50    my (@incs) = ($inc);
51    my $crazy = ccflags();
52    if ($crazy =~ s#/inc[^=/]*=([\w\$\_\-\.\[\]\:]+)##i) {
53        push(@incs,$1);
54    }
55    if ($crazy =~ s/-I([a-zA-Z0-9\$\_\-\.\[\]\:]*)//) {
56        push(@incs,$1);
57    }
58    $crazy =~ s#/Obj[^=/]*=[\w\$\_\-\.\[\]\:]+##i;
59    push(@cmd,"/Include=(".join(',',@incs).")");
60    push(@cmd,$crazy);
61    push(@cmd,"embed_test.c");
62
63    push(@cmd2,$Config{'ld'}, $Config{'ldflags'}, "/exe=$exe");
64    push(@cmd2,"$obj,[-]perlshr.opt/opt,[-]perlshr_attr.opt/opt");
65
66} else {
67   if ($cl) {
68    push(@cmd,$cc,"-Fe$exe");
69   }
70   else {
71    push(@cmd,$cc,'-o' => $exe);
72   }
73   if ($^O eq 'dec_osf' && !defined $Config{usedl}) {
74       # The -non_shared is needed in case of -Uusedl or otherwise
75       # the test application will try to use libperl.so
76       # instead of libperl.a.
77       push @cmd, "-non_shared";
78   }
79
80   # XXX DAPM 12/2014: ExtUtils::Embed doesn't seem to provide API access
81   # to $Config{optimize} and so compiles the test code without
82   # optimisation on optimised perls. This causes the compiler to warn
83   # when -D_FORTIFY_SOURCE is in force without -O. For now, just strip
84   # the fortify on optimised builds to avoid the warning.
85   my $ccflags =  ccflags();
86   $ccflags =~ s/-D_FORTIFY_SOURCE=\d+// if $Config{optimize} =~ /-O/;
87
88   push(@cmd, "-I$inc", $ccflags, 'embed_test.c');
89   if ($^O eq 'MSWin32') {
90    $inc = File::Spec->catdir($inc,'win32');
91    push(@cmd,"-I$inc");
92    $inc = File::Spec->catdir($inc,'include');
93    push(@cmd,"-I$inc");
94    if ($cc eq 'cl') {
95	push(@cmd,'-link',"-libpath:$lib\\lib\\CORE",$Config{'libperl'},$Config{'libs'});
96    }
97    else {
98	push(@cmd,"-L$lib",$lib.'\lib\CORE\\'.$Config{'libperl'},$Config{'libc'});
99    }
100   }
101   elsif ($^O eq 'os390' && $Config{usedl}) {
102    push(@cmd,"-L$lib", ldopts());
103   } else { # Not MSWin32 or OS/390 (z/OS) dynamic.
104    push(@cmd,"-L$lib",'-lperl');
105    local $SIG{__WARN__} = sub {
106	warn $_[0] unless $_[0] =~ /No library found for .*perl/
107    };
108    push(@cmd, '-Zlinker', '/PM:VIO')	# Otherwise puts a warning to STDOUT!
109	if $^O eq 'os2' and $Config{ldflags} =~ /(?<!\S)-Zomf\b/;
110    push(@cmd,ldopts());
111   }
112
113   if ($^O eq 'aix') { # AIX needs an explicit symbol export list.
114    my ($perl_exp) = grep { -f } qw(perl.exp ../perl.exp);
115    die "where is perl.exp?\n" unless defined $perl_exp;
116    for (@cmd) {
117        s!-bE:(\S+)!-bE:$perl_exp!;
118    }
119   }
120   elsif ($^O eq 'cygwin') { # Cygwin needs no special treatment like below
121       ;
122   }
123   elsif ($Config{'libperl'} !~ /\Alibperl\./) {
124     # Everyone needs libperl copied if it's not found by '-lperl'.
125     $testlib = $Config{'libperl'};
126     my $srclib = $testlib;
127     $testlib =~ s/.+(?=\.[^.]*)/libperl/;
128     $testlib = File::Spec::->catfile($lib, $testlib);
129     $srclib = File::Spec::->catfile($lib, $srclib);
130     if (-f $srclib) {
131       unlink $testlib if -f $testlib;
132       my $ln_or_cp = $Config{'ln'} || $Config{'cp'};
133       my $lncmd = "$ln_or_cp $srclib $testlib";
134       #print "# $lncmd\n";
135       $libperl_copied = 1	unless system($lncmd);
136     }
137   }
138}
139my $status;
140# On OS/2 the linker will always emit an empty line to STDOUT; filter these
141my $cmd = join ' ', @cmd;
142chomp($cmd); # where is the newline coming from? ldopts()?
143print "# $cmd\n";
144my @out = `$cmd`;
145$status = $?;
146print "# $_\n" foreach @out;
147
148if ($^O eq 'VMS' && !$status) {
149  print "# @cmd2\n";
150  $status = system(join(' ',@cmd2));
151}
152print (($status? 'not ': '')."ok 1\n");
153
154my $embed_test = File::Spec->catfile(File::Spec->curdir, $exe);
155$embed_test = "run/nodebug $exe" if $^O eq 'VMS';
156print "# embed_test = $embed_test\n";
157$status = system($embed_test);
158print (($status? 'not ':'')."ok 10 # system returned $status\n");
159unlink($exe,"embed_test.c",$obj);
160unlink("$exe.manifest") if $cl and $Config{'ccversion'} =~ /^(\d+)/ and $1 >= 14;
161unlink("$exe$Config{exe_ext}") if $skip_exe;
162unlink("embed_test.map","embed_test.lis") if $^O eq 'VMS';
163unlink(glob("./*.dll")) if $^O eq 'cygwin';
164unlink($testlib)	       if $libperl_copied;
165
166# gcc -g -I.. -L../ -o perl_test perl_test.c -lperl `../perl -I../lib -MExtUtils::Embed -I../ -e ccflags -e ldopts`
167__END__
168
169/* perl_test.c */
170
171#include <EXTERN.h>
172#include <perl.h>
173
174#define my_puts(a) if(puts(a) < 0) exit(666)
175
176static const char * cmds [] = { "perl", "-e", "$|=1; print qq[ok 5\\n]; $SIG{__WARN__} = sub { print qq[ok 6\\n] if $_[0] =~ /Unexpected exit/; }; exit 5;", NULL };
177
178#ifdef PERL_GLOBAL_STRUCT_PRIVATE
179static struct perl_vars *my_plvarsp;
180struct perl_vars* Perl_GetVarsPrivate(void) { return my_plvarsp; }
181#endif
182
183#ifdef NO_ENV_ARRAY_IN_MAIN
184int main(int argc, char **argv) {
185    char **env;
186#else
187int main(int argc, char **argv, char **env) {
188#endif
189    PerlInterpreter *my_perl;
190#ifdef PERL_GLOBAL_STRUCT
191    struct perl_vars *my_vars = init_global_struct();
192#  ifdef PERL_GLOBAL_STRUCT_PRIVATE
193    int veto;
194
195    my_plvarsp = my_vars;
196#  endif
197#endif /* PERL_GLOBAL_STRUCT */
198
199    (void)argc; /* PERL_SYS_INIT3 may #define away their use */
200    (void)argv;
201    PERL_SYS_INIT3(&argc, &argv, &env);
202
203    my_perl = perl_alloc();
204
205    my_puts("ok 2");
206
207    perl_construct(my_perl);
208    PL_exit_flags |= PERL_EXIT_WARN;
209
210    my_puts("ok 3");
211
212    perl_parse(my_perl, NULL, (sizeof(cmds)/sizeof(char *))-1, (char **)cmds, env);
213
214    my_puts("ok 4");
215
216    fflush(stdout);
217
218    perl_run(my_perl);
219
220    my_puts("ok 7");
221
222    perl_destruct(my_perl);
223
224    my_puts("ok 8");
225
226    perl_free(my_perl);
227
228    my_puts("ok 9");
229
230    PERL_SYS_TERM();
231
232#ifdef PERL_GLOBAL_STRUCT
233#  ifdef PERL_GLOBAL_STRUCT_PRIVATE
234    veto = my_plvarsp->Gveto_cleanup;
235#  endif
236    free_global_struct(my_vars);
237#  ifdef PERL_GLOBAL_STRUCT_PRIVATE
238    if (!veto)
239        my_plvarsp = NULL;
240    /* Remember, functions registered with atexit() can run after this point,
241       and may access "global" variables, and hence end up calling
242       Perl_GetVarsPrivate()  */
243#endif
244#endif /* PERL_GLOBAL_STRUCT */
245
246    return 0;
247}
248