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