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 the shared libperl copied 109 my $v_e_r_s = $Config{version}; 110 $v_e_r_s =~ tr/./_/; 111 system("cp ../cygperl$v_e_r_s.dll ./"); # for test 1 112 } 113 elsif ($Config{'libperl'} !~ /\Alibperl\./) { 114 # Everyone needs libperl copied if it's not found by '-lperl'. 115 $testlib = $Config{'libperl'}; 116 my $srclib = $testlib; 117 $testlib =~ s/.+(?=\.[^.]*)/libperl/; 118 $testlib = File::Spec::->catfile($lib, $testlib); 119 $srclib = File::Spec::->catfile($lib, $srclib); 120 if (-f $srclib) { 121 unlink $testlib if -f $testlib; 122 my $ln_or_cp = $Config{'ln'} || $Config{'cp'}; 123 my $lncmd = "$ln_or_cp $srclib $testlib"; 124 #print "# $lncmd\n"; 125 $libperl_copied = 1 unless system($lncmd); 126 } 127 } 128} 129my $status; 130# On OS/2 the linker will always emit an empty line to STDOUT; filter these 131my $cmd = join ' ', @cmd; 132chomp($cmd); # where is the newline coming from? ldopts()? 133print "# $cmd\n"; 134my @out = `$cmd`; 135$status = $?; 136print "# $_\n" foreach @out; 137 138if ($^O eq 'VMS' && !$status) { 139 print "# @cmd2\n"; 140 $status = system(join(' ',@cmd2)); 141} 142print (($status? 'not ': '')."ok 1\n"); 143 144my $embed_test = File::Spec->catfile(File::Spec->curdir, $exe); 145$embed_test = "run/nodebug $exe" if $^O eq 'VMS'; 146print "# embed_test = $embed_test\n"; 147$status = system($embed_test); 148print (($status? 'not ':'')."ok 9 # system returned $status\n"); 149unlink($exe,"embed_test.c",$obj); 150unlink("$exe.manifest") if $cl and $Config{'ccversion'} =~ /^(\d+)/ and $1 >= 14; 151unlink("$exe$Config{exe_ext}") if $skip_exe; 152unlink("embed_test.map","embed_test.lis") if $^O eq 'VMS'; 153unlink(glob("./*.dll")) if $^O eq 'cygwin'; 154unlink($testlib) if $libperl_copied; 155 156# gcc -g -I.. -L../ -o perl_test perl_test.c -lperl `../perl -I../lib -MExtUtils::Embed -I../ -e ccflags -e ldopts` 157__END__ 158 159/* perl_test.c */ 160 161#include <EXTERN.h> 162#include <perl.h> 163 164#define my_puts(a) if(puts(a) < 0) exit(666) 165 166static char *cmds[] = { "perl","-e", "$|=1; print qq[ok 5\\n]", NULL }; 167 168#ifdef PERL_GLOBAL_STRUCT_PRIVATE 169static struct perl_vars *my_plvarsp; 170struct perl_vars* Perl_GetVarsPrivate(void) { return my_plvarsp; } 171#endif 172 173#ifdef NO_ENV_ARRAY_IN_MAIN 174extern char **environ; 175int main(int argc, char **argv) 176#else 177int main(int argc, char **argv, char **env) 178#endif 179{ 180 PerlInterpreter *my_perl; 181#ifdef PERL_GLOBAL_STRUCT 182 dVAR; 183 struct perl_vars *plvarsp = init_global_struct(); 184# ifdef PERL_GLOBAL_STRUCT_PRIVATE 185 my_vars = my_plvarsp = plvarsp; 186# endif 187#endif /* PERL_GLOBAL_STRUCT */ 188 189 (void)argc; /* PERL_SYS_INIT3 may #define away their use */ 190 (void)argv; 191#ifdef NO_ENV_ARRAY_IN_MAIN 192 PERL_SYS_INIT3(&argc,&argv,&environ); 193#else 194 PERL_SYS_INIT3(&argc,&argv,&env); 195#endif 196 197 my_perl = perl_alloc(); 198 199 my_puts("ok 2"); 200 201 perl_construct(my_perl); 202 203 my_puts("ok 3"); 204 205#ifdef NO_ENV_ARRAY_IN_MAIN 206 perl_parse(my_perl, NULL, (sizeof(cmds)/sizeof(char *))-1, cmds, environ); 207#else 208 perl_parse(my_perl, NULL, (sizeof(cmds)/sizeof(char *))-1, cmds, env); 209#endif 210 211 my_puts("ok 4"); 212 213 fflush(stdout); 214 215 perl_run(my_perl); 216 217 my_puts("ok 6"); 218 219 perl_destruct(my_perl); 220 221 my_puts("ok 7"); 222 223 perl_free(my_perl); 224 225#ifdef PERL_GLOBAL_STRUCT 226 free_global_struct(plvarsp); 227#endif /* PERL_GLOBAL_STRUCT */ 228 229 my_puts("ok 8"); 230 231 PERL_SYS_TERM(); 232 233 return 0; 234} 235