X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=utils%2Fperlcc.PL;h=361069edf25e4513ae1c54f2d300052634e6c2b8;hb=59910b6dbc5bdf043d9f33f40bbbc9957f008770;hp=cdd7759b31b7cf070f8fac2ab75e9914e6c5a0ff;hpb=f5eac2152adebf3de703707e233f00e2cd249b47;p=p5sagit%2Fp5-mst-13.2.git diff --git a/utils/perlcc.PL b/utils/perlcc.PL index cdd7759..361069e 100644 --- a/utils/perlcc.PL +++ b/utils/perlcc.PL @@ -42,17 +42,18 @@ print OUT <<'!NO!SUBS!'; # Version 2.01, Tom Christiansen, Thu Mar 30 08:25:14 MST 2000 # Version 2.02, Simon Cozens, Sun Apr 16 01:53:36 JST 2000 # Version 2.03, Edward Peschko, Mon Feb 26 12:04:17 PST 2001 +# Version 2.04, Enache Adrian,Fri, 18 Jul 2003 23:15:37 +0300 use strict; use warnings; -use v5.6.0; +use 5.006_000; use FileHandle; use Config; use Fcntl qw(:DEFAULT :flock); use File::Temp qw(tempfile); use Cwd; -our $VERSION = 2.03; +our $VERSION = 2.04; $| = 1; $SIG{INT} = sub { exit(); }; # exit gracefully and clean up after ourselves. @@ -63,11 +64,14 @@ use subs qw{ grab_stash parse_argv sanity_check vprint yclept spawnit }; sub opt(*); # imal quoting +sub is_win32(); +sub is_msvc(); our ($Options, $BinPerl, $Backend); our ($Input => $Output); our ($logfh); our ($cfile); +our (@begin_output); # output from BEGIN {}, for testsuite # eval { main(); 1 } or die; @@ -161,7 +165,7 @@ sub parse_argv { 'L:s', # lib directory 'I:s', # include directories (FOR C, NOT FOR PERL) 'o:s', # Output executable - 'v:i', # Verbosity level + 'v:i', # Verbosity level 'e:s', # One-liner 'r', # run resulting executable 'B', # Byte compiler backend @@ -170,24 +174,35 @@ sub parse_argv { 'h', # Help me 'S', # Dump C files 'r', # run the resulting executable + 'T', # run the backend using perl -T + 't', # run the backend using perl -t 'static', # Dirty hack to enable -shared/-static 'shared', # Create a shared library (--shared for compat.) - 'log:s' # where to log compilation process information + 'log:s', # where to log compilation process information + 'Wb:s', # pass (comma-sepearated) options to backend + 'testsuite', # try to be nice to testsuite ); - + $Options->{v} += 0; + if( opt(t) && opt(T) ) { + warn "Can't specify both -T and -t, -t ignored"; + $Options->{t} = 0; + } + helpme() if opt(h); # And exit - $Output = opt(o) || 'a.out'; - $Output = relativize($Output); + $Output = opt(o) || ( is_win32 ? 'a.exe' : 'a.out' ); + $Output = is_win32() ? $Output : relativize($Output); $logfh = new FileHandle(">> " . opt('log')) if (opt('log')); if (opt(e)) { warn "$0: using -e 'code' as input file, ignoring @ARGV\n" if @ARGV; # We don't use a temporary file here; why bother? # XXX: this is not bullet proof -- spaces or quotes in name! - $Input = "-e '".opt(e)."'"; # Quotes eaten by shell + $Input = is_win32() ? # Quotes eaten by shell + '-e "'.opt(e).'"' : + "-e '".opt(e)."'"; } else { $Input = shift @ARGV; # XXX: more files? _usage_and_die("$0: No input file specified\n") unless $Input; @@ -211,64 +226,48 @@ sub compile_module { } sub compile_byte { - require ByteLoader; - my $stash = grab_stash(); - my $command = "$BinPerl -MO=Bytecode,$stash $Input"; - # The -a option means we'd have to close the file and lose the - # lock, which would create the tiniest of races. Instead, append - # the output ourselves. - vprint 1, "Writing on $Output"; - - my $openflags = O_WRONLY | O_CREAT; - $openflags |= O_BINARY if eval { O_BINARY; 1 }; - $openflags |= O_EXLOCK if eval { O_EXLOCK; 1 }; - - # these dies are not "$0: .... \n" because they "can't happen" - - sysopen(OUT, $Output, $openflags) - or die "can't write to $Output: $!"; - - # this is blocking; hold on; why are we doing this?? - # flock OUT, LOCK_EX or die "can't lock $Output: $!" - # unless eval { O_EXLOCK; 1 }; - - truncate(OUT, 0) - or die "couldn't trunc $Output: $!"; - - print OUT <&STDOUT') or die $!",} . + q{-e"open(Test::Builder::TESTERR\054 '>&STDERR') or die $!",}; + } if (opt(S) || opt(c)) { # We need to keep it. if (opt(e)) { @@ -297,7 +296,7 @@ sub compile_cstyle { # This has to do the write itself, so we can't keep a lock. Life # sucks. - my $command = "$BinPerl -MO=$Backend,$max_line_len$stash,-o$cfile $Input"; + my $command = "$BinPerl $taint -MO=$Backend,$addoptions$testsuite$max_line_len$stash,-o$cfile $Input"; vprint 1, "Compiling..."; vprint 1, "Calling $command"; @@ -309,7 +308,9 @@ sub compile_cstyle { _die("$0: $Input did not compile, which can't happen:\n@error\n"); } - cc_harness($cfile,$stash) unless opt(c); + is_msvc ? + cc_harness_msvc($cfile,$stash) : + cc_harness($cfile,$stash) unless opt(c); if ($lose) { vprint 2, "unlinking $cfile"; @@ -317,6 +318,23 @@ sub compile_cstyle { } } +sub cc_harness_msvc { + my ($cfile,$stash)=@_; + use ExtUtils::Embed (); + my $obj = "${Output}.obj"; + my $compile = ExtUtils::Embed::ccopts." -c -Fo$obj $cfile "; + my $link = "-out:$Output $obj"; + $compile .= " -I".$_ for split /\s+/, opt(I); + $link .= " -libpath:".$_ for split /\s+/, opt(L); + my @mods = split /-?u /, $stash; + $link .= " ".ExtUtils::Embed::ldopts("-std", \@mods); + $link .= " perl5$Config{PERL_VERSION}.lib kernel32.lib msvcrt.lib"; + vprint 3, "running $Config{cc} $compile"; + system("$Config{cc} $compile"); + vprint 3, "running $Config{ld} $link"; + system("$Config{ld} $link"); +} + sub cc_harness { my ($cfile,$stash)=@_; use ExtUtils::Embed (); @@ -356,7 +374,9 @@ sub yclept { warn "already called get_stash once" if $_stash; - my $command = "$BinPerl -MB::Stash -c $Input"; + my $taint = opt(T) ? '-T' : + opt(t) ? '-t' : ''; + my $command = "$BinPerl $taint -MB::Stash -c $Input"; # Filename here is perfectly sanitised. vprint 3, "Calling $command\n"; @@ -368,7 +388,14 @@ sub yclept { _die("$0: $Input did not compile:\n@error\n"); } + # band-aid for modules with noisy BEGIN {} + foreach my $i ( @stash ) { + $i =~ m/-u(?:[\w:]+|\)$/ and $stash[0] = $i and next; + push @begin_output, $i; + } + chomp $stash[0]; $stash[0] =~ s/,-u\//; + $stash[0] =~ s/^.*?-u/-u/s; vprint 2, "Stash: ", join " ", split /,?-u/, $stash[0]; chomp $stash[0]; return $_stash = $stash[0]; @@ -502,7 +529,7 @@ sub _die { sub _usage_and_die { _die(<