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 my $full = File::Spec->catdir($inc,'full'); 93 push(@cmd,"-I$full"); 94 $inc = File::Spec->catdir($inc,'include'); 95 push(@cmd,"-I$inc"); 96 if ($cc eq 'cl') { 97 push(@cmd,'-link',"-libpath:$lib\\lib\\CORE",$Config{'libperl'},$Config{'libs'}); 98 } 99 else { 100 push(@cmd,"-L$lib",$lib.'\lib\CORE\\'.$Config{'libperl'},$Config{'libc'}); 101 } 102 } 103 elsif ($^O eq 'os390' && $Config{usedl}) { 104 push(@cmd,"-L$lib", ldopts()); 105 } else { # Not MSWin32 or OS/390 (z/OS) dynamic. 106 push(@cmd,"-L$lib",'-lperl'); 107 local $SIG{__WARN__} = sub { 108 warn $_[0] unless $_[0] =~ /No library found for .*perl/ 109 }; 110 push(@cmd, '-Zlinker', '/PM:VIO') # Otherwise puts a warning to STDOUT! 111 if $^O eq 'os2' and $Config{ldflags} =~ /(?<!\S)-Zomf\b/; 112 push(@cmd,ldopts()); 113 } 114 115 if ($^O eq 'aix') { # AIX needs an explicit symbol export list. 116 my ($perl_exp) = grep { -f } qw(perl.exp ../perl.exp); 117 die "where is perl.exp?\n" unless defined $perl_exp; 118 for (@cmd) { 119 s!-bE:(\S+)!-bE:$perl_exp!; 120 } 121 } 122 elsif ($^O eq 'cygwin') { # Cygwin needs no special treatment like below 123 ; 124 } 125 elsif ($Config{'libperl'} !~ /\Alibperl\./) { 126 # Everyone needs libperl copied if it's not found by '-lperl'. 127 $testlib = $Config{'libperl'}; 128 my $srclib = $testlib; 129 $testlib =~ s/.+(?=\.[^.]*)/libperl/; 130 $testlib = File::Spec::->catfile($lib, $testlib); 131 $srclib = File::Spec::->catfile($lib, $srclib); 132 if (-f $srclib) { 133 unlink $testlib if -f $testlib; 134 my $ln_or_cp = $Config{'ln'} || $Config{'cp'}; 135 my $lncmd = "$ln_or_cp $srclib $testlib"; 136 #print "# $lncmd\n"; 137 $libperl_copied = 1 unless system($lncmd); 138 } 139 } 140} 141my $status; 142# On OS/2 the linker will always emit an empty line to STDOUT; filter these 143my $cmd = join ' ', @cmd; 144chomp($cmd); # where is the newline coming from? ldopts()? 145print "# $cmd\n"; 146my @out = `$cmd`; 147$status = $?; 148print "# $_\n" foreach @out; 149 150if ($^O eq 'VMS' && !$status) { 151 print "# @cmd2\n"; 152 $status = system(join(' ',@cmd2)); 153} 154print (($status? 'not ': '')."ok 1\n"); 155 156my $embed_test = File::Spec->catfile(File::Spec->curdir, $exe); 157$embed_test = "run/nodebug $exe" if $^O eq 'VMS'; 158print "# embed_test = $embed_test\n"; 159$status = system($embed_test); 160print (($status? 'not ':'')."ok 10 # system returned $status\n"); 161unlink($exe,"embed_test.c",$obj); 162unlink("$exe.manifest") if $cl and $Config{'ccversion'} =~ /^(\d+)/ and $1 >= 14; 163unlink("$exe$Config{exe_ext}") if $skip_exe; 164unlink("embed_test.map","embed_test.lis") if $^O eq 'VMS'; 165unlink(glob("./*.dll")) if $^O eq 'cygwin'; 166unlink($testlib) if $libperl_copied; 167 168# gcc -g -I.. -L../ -o perl_test perl_test.c -lperl `../perl -I../lib -MExtUtils::Embed -I../ -e ccflags -e ldopts` 169__END__ 170 171/* perl_test.c */ 172 173#include <EXTERN.h> 174#include <perl.h> 175 176#define my_puts(a) if(puts(a) < 0) exit(666) 177 178static 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 }; 179 180#ifdef NO_ENV_ARRAY_IN_MAIN 181int main(int argc, char **argv) { 182 char **env; 183#else 184int main(int argc, char **argv, char **env) { 185#endif 186 PerlInterpreter *my_perl; 187 188 (void)argc; /* PERL_SYS_INIT3 may #define away their use */ 189 (void)argv; 190 PERL_SYS_INIT3(&argc, &argv, &env); 191 192 my_perl = perl_alloc(); 193 194 my_puts("ok 2"); 195 196 perl_construct(my_perl); 197 PL_exit_flags |= PERL_EXIT_WARN; 198 199 my_puts("ok 3"); 200 201 perl_parse(my_perl, NULL, (sizeof(cmds)/sizeof(char *))-1, (char **)cmds, env); 202 203 my_puts("ok 4"); 204 205 fflush(stdout); 206 207 perl_run(my_perl); 208 209 my_puts("ok 7"); 210 211 perl_destruct(my_perl); 212 213 my_puts("ok 8"); 214 215 perl_free(my_perl); 216 217 my_puts("ok 9"); 218 219 PERL_SYS_TERM(); 220 221 return 0; 222} 223