Permalink
Browse files

C: fix %cvstashname, add t/testc/sh 411

fix mingw importlib name.

use the B $padlist->id, $padlist->outid methods,
remove our variant from C.xs,
I've overlooked these. (undocumented in B).
  • Loading branch information...
1 parent ace5006 commit 78c2e44818c03877198878315360290aa14ed411 @rurban committed Jul 26, 2017
Showing with 73 additions and 46 deletions.
  1. +0 −11 C.xs
  2. +10 −10 Makefile.PL
  3. +8 −7 lib/B/C.pm
  4. +17 −5 script/perlcc.PL
  5. +5 −2 t/c_argv.t
  6. +4 −1 t/e_perlcc.t
  7. +1 −1 t/modules.pm
  8. +18 −9 t/modules.t
  9. +1 −0 t/perldoc.t
  10. +9 −0 t/testc.sh
View
11 C.xs
@@ -544,17 +544,6 @@ PadnameGEN(padn)
OUTPUT:
RETVAL
-MODULE = B PACKAGE = B::PADLIST PREFIX = Padlist
-
-U32
-PadlistID(padlist)
- B::PADLIST padlist
- ALIAS: B::PADLIST::OUTID = 1
- CODE:
- RETVAL = ix ? padlist->xpadl_outid : padlist->xpadl_id;
- OUTPUT:
- RETVAL
-
MODULE = B PACKAGE = B::PADNAMELIST PREFIX = Padnamelist
size_t
View
@@ -167,13 +167,12 @@ elsif ($] > 5.015005 and $] < 5.019004) {
($Config{usecperl} ? "" :
" Enable use warnings 'syscalls'.\n");
}
-if ($] >= 5.025002 and !$Config{usecperl}) {
- warn "Warning:\n".
- " B-C is not yet supported for perl-5.26, only cperl-5.26.\n".
- " Most old code will work though.\n";
-}
my $perlcc = File::Spec->catfile("script", "perlcc");
+if ($CORE and $^O eq 'MSWin32') {
+ $perldll = $Config{usecperl} ? "cperl*.dll" : "perl*.dll";
+ system("copy ..\..\$perldll *.*");
+}
WriteMakefile(
NAME => "B::C",
@@ -187,8 +186,8 @@ WriteMakefile(
'ExtUtils::Embed' => '1.25' # mandatory (missing on redhat)
#'B' => '1.0901' # required but in CORE
},
- 'AUTHOR' => 'Malcolm Beattie (retired), '
- . 'Reini Urban <perl-compiler@googlegroups.com>',
+ 'AUTHOR' => 'Reini Urban <perl-compiler@googlegroups.com>, '
+ . 'Malcolm Beattie (retired)',
'ABSTRACT' => 'Perl compiler',
'LICENSE' => 'perl',
# was in core until 5.9.5, need to update it there
@@ -225,9 +224,10 @@ WriteMakefile(
"lib/B/Asmdata.pm script/perlcc ccode* cccode* Ccode* lib/B/C/Config.pm ".
"*.core *.stackdump a.out a.exe *.cee *.c *.asm *.dbg *.plc *.obj ".
"*.concise *~ dll.base dll.exp mod.pl pcc* *.bak *.a ".
- "t/CORE/v5.*/*/*.bin t/CORE/v5.*/*/*.c Io_argv* t/CORE/v5.*/*/*.subtest.*.t".
- "t/CORE/v5.*/xtestc* t/CORE/v5.*/C-COMPILED/xtestc/*.t".
- "t/CORE/v5.*/tmp* tmp*"
+ "t/CORE/v5.*/*/*.bin t/CORE/v5.*/*/*.c Io_argv* t/CORE/v5.*/*/*.subtest.*.t ".
+ "t/CORE/v5.*/xtestc* t/CORE/v5.*/C-COMPILED/xtestc/*.t ".
+ "t/CORE/v5.*/tmp* tmp* ".
+ "perl*.dll cperl*.dll "
},
);
View
@@ -504,6 +504,7 @@ our %optimization_map = (
4 => [qw(-fcop -fno-dyn-padlist)],
);
push @{$optimization_map{2}}, '-fcow' if $] >= 5.020;
+# skipping here: oFr which need extra logic
our %debug_map = (
'O' => 'op',
'A' => 'av',
@@ -4275,7 +4276,7 @@ sub B::CV::save {
}
# XXX how is ANON with CONST handled? CONST uses XSUBANY [GH #246]
- if ($isconst and $gv and $cvxsub and !is_phase_name($cvname) and
+ if ($isconst and $cvxsub and !is_phase_name($cvname) and
(
(
$PERL522
@@ -4309,7 +4310,7 @@ sub B::CV::save {
# TODO Attribute::Handlers #171, test 176
if ($sv and ref($sv) and ref($sv) =~ /^(SCALAR|ARRAY|HASH|CODE|REF)$/) {
# Save XSUBANY, maybe ARRAY or HASH also?
- warn "SCALAR const sub $cvstashname::$cvname -> $sv\n" if $debug{cv};
+ warn "SCALAR const sub $cvstashname\::$cvname -> $sv\n" if $debug{cv};
my $vsym = svref_2object( \$sv )->save;
my $cvi = "cv".$cv_index++;
$decl->add("Static CV* $cvi;");
@@ -4323,7 +4324,7 @@ sub B::CV::save {
$init->add("$cvi = newCONSTSUB( $stsym, $name, (SV*)$vsym );");
return savesym( $cv, $cvi );
} else {
- warn "Warning: Undefined const sub $cvstashname::$cvname -> $sv\n" if $verbose;
+ warn "Warning: Undefined const sub $cvstashname\::$cvname -> $sv\n" if $verbose;
}
}
@@ -4366,7 +4367,7 @@ sub B::CV::save {
my $reloaded;
if ($cvstashname =~ /^(bytes|utf8)$/) { # no autoload, force compile-time
force_heavy($cvstashname);
- $cv = svref_2object( \&{"$cvstashname\::$cvname"} );
+ $cv = svref_2object( \&{$cvstashname."::".$cvname} );
$reloaded = 1;
} elsif ($fullname eq 'Coro::State::_jit') { # 293
# need to force reload the jit src
@@ -4459,7 +4460,7 @@ sub B::CV::save {
if (!$$root) {
if ($fullname ne 'threads::tid'
and $fullname ne 'main::main::'
- and ($PERL510 and !defined(&{"$cvstashname\::AUTOLOAD"})))
+ and ($PERL510 and !defined(&{$cvstashname."::AUTOLOAD"})))
{
# XXX What was here?
}
@@ -5543,7 +5544,7 @@ sub B::AV::save {
}
elsif ($ispadlist and $] >= 5.021008) { # id+outid as U32 (PL_padlist_generation++)
$padlistsect->comment("xpadl_max, xpadl_alloc, xpadl_id, xpadl_outid");
- my ($id, $outid) = ($av->ID, $av->OUTID);
+ my ($id, $outid) = ($av->id, $av->outid);
$padlistsect->add("$fill, NULL, $id, $outid");
$padlist_index = $padlistsect->index;
$sym = savesym( $av, "&padlist_list[$padlist_index]" );
@@ -8704,7 +8705,7 @@ sub save_main {
set_curcv B::main_cv;
seek( STDOUT, 0, 0 ); #exclude print statements in BEGIN{} into output
binmode( STDOUT, ':utf8' ) unless $PERL56;
-
+
$verbose
? walkoptree_slow( main_root, "save" )
: walkoptree( main_root, "save" );
View
@@ -64,6 +64,7 @@ print OUT <<'!NO!SUBS!';
# Version 2.19, Reini Urban, 2014-07-09
# Version 2.20, Reini Urban, 2014-07-23
# Version 2.21, Reini Urban, 2016-06-12
+# Version 2.22, Reini Urban, 2017-07-23
use strict;
use warnings;
@@ -78,7 +79,7 @@ use Cwd ();
use Pod::Usage;
# Time::HiRes does not work with 5.6
# use Time::HiRes qw(gettimeofday tv_interval);
-our $VERSION = 2.21;
+our $VERSION = 2.22;
$| = 1;
eval { require B::C::Config; };
@@ -690,10 +691,13 @@ sub cc_harness {
my ($cfile, $stash, $extra_libs) = @_;
use ExtUtils::Embed ();
my $command = ExtUtils::Embed::ccopts." -o \"$Output\" \"$cfile\" ";
+ my $coredir;
if ($ENV{PERL_CORE}) {
!NO!SUBS!
print OUT <<"!EXPANDED!";
- \$command = "\$Config{ccflags} -I\\\"$srcdir\\\" -L\\\"$srcdir\\\" -o \\\"\$Output\\\" \\\"\$cfile\\\" ";
+ \$coredir = \"$srcdir\";
+ \$coredir .= \"\\\\lib\\\\CORE\" if \$^O eq 'MSWin32';
+ \$command = "\$Config{ccflags} -I\\\"\$coredir\\\" -L\\\"\$coredir\\\" -o \\\"\$Output\\\" \\\"\$cfile\\\" ";
!EXPANDED!
print OUT <<'!NO!SUBS!';
}
@@ -716,7 +720,12 @@ print OUT <<'!NO!SUBS!';
}
}
$command .= " -DSTATICXS" if opt('staticxs');
- $command .= " ".opt('Wc') if opt('Wc');
+ my $optWc = opt('Wc');
+ if ($optWc) {
+ $command .= " $optWc";
+ # no override warning
+ $command =~ s/\b-O.\b/-O0/ if $optWc =~ /\b-O0\b/;
+ }
my $ccflags = $command;
my $useshrplib = $Config{useshrplib} =~ /^(true|yes)$/;
@@ -753,9 +762,12 @@ print OUT <<'!NO!SUBS!';
}
}
}
- my ($libperl, $libdir, $coredir) = ($Config{libperl});
+ my ($libperl, $libdir) = ($Config{libperl});
if ($ENV{PERL_CORE}) {
- $libdir = $coredir = "../.."; # not includedir, which is ../../lib/CORE on windows
+ # on mingw we still search for cperl52x.dll not the importlib
+ # coredir + includedir is ../../lib/CORE on windows
+ $libdir = "../..";
+ $ldopts .= " -L$coredir" if $^O eq 'MSWin32';
} else {
$libdir = $Config{prefix} . "/lib";
$coredir = $ENV{PERL_SRC} || $Config{archlib}."/CORE";
View
@@ -7,20 +7,23 @@ BEGIN {
}
use Test::More;
-plan skip_all => "MSVC" if $^O eq 'MSWin32' and $Config{cc} eq 'cl';
+# but works locally
+plan skip_all => "mingw on appveyor"
+ if $^O eq 'MSWin32' and $Config{cc} eq 'gcc' and $ENV{APPVEYOR};
plan tests => 4;
my $runperl = $^X =~ m/\s/ ? qq{"$^X"} : $^X;
my $Mblib = Mblib();
my $perlcc = perlcc();
my $exe = $^O eq 'MSWin32' ? 'ccode_argv.exe' : 'ccode_argv';
-my $pl = $^O eq 'MSWin32' ? "t\\c_argv.pl" : "t/c_argv.pl";
+my $pl = $^O eq 'MSWin32' ? "t\\c_argv.pl" : "t/c_argv.pl";
my $plc = $pl . "c";
my $d = <DATA>;
open F, ">", $pl;
print F $d;
close F;
+diag "$runperl $Mblib $perlcc -O3 -o $exe -r $pl ok 1" if $ENV{TEST_VERBOSE};
is(`$runperl $Mblib $perlcc -O3 -o $exe -r $pl ok 1`, "ok 1\n", #1
"perlcc -r file args");
unlink($exe);
View
@@ -53,6 +53,9 @@ my $redir = $^O eq 'MSWin32' ? '' : '2>&1';
my $devnull = $^O eq 'MSWin32' ? '' : '2>/dev/null';
# VC takes a couple hours to compile each executable in -O1
my $Wcflags = $^O eq 'MSWin32' && $Config{cc} =~ /cl/ ? ' --Wc=-Od' : '';
+if ($^O eq 'MSWin32' && $Config{cc} =~ /gcc/) { # mingw is not much better
+ $Wcflags = ' --Wc=-O0';
+}
my $ITHREADS = $Config{useithreads};
#my $o = '';
#$o = "-Wb=-fno-warnings" if $] >= 5.013005;
@@ -95,7 +98,7 @@ cleanup;
TODO: {
# fails 5.8 and before sometimes on darwin, msvc also.
local $TODO = '--staticxs is experimental on darwin and <5.10' if $] < 5.010
- or ($^O eq 'darwin' and $ITHREADS);
+ or $^O eq 'darwin';
is(`$perlcc --staticxs -r -e $e $devnull`, "ok", "-r --staticxs xs"); #13
ok(-e $a_exe, "keep default executable"); #14
}
View
@@ -107,7 +107,7 @@ sub get_module_list {
close F;
@modules = grep {s/\s+//g;!/^#/} split /\n/, $s;
- diag "scanning installed modules";
+ diag "scanning installed modules" unless $ENV{PERL_CORE};
for my $m (@modules) {
# redirect stderr
open (SAVEOUT, ">&STDERR");
View
@@ -41,11 +41,14 @@ use Config;
my $ccopts;
BEGIN {
- plan skip_all => "skipped: Overlong tests, timeout on Appveyor CI"
+ plan skip_all => "Overlong tests, timeout on Appveyor CI"
if $^O eq 'MSWin32' and $ENV{APPVEYOR};
if ($^O eq 'MSWin32' and $Config{cc} eq 'cl') {
# MSVC takes an hour to compile each binary unless -Od
$ccopts = '"--Wc=-Od"';
+ } elsif ($^O eq 'MSWin32' and $Config{cc} eq 'gcc') {
+ # mingw is much better but still insane with <= 4GB RAM
+ $ccopts = '"--Wc=-O0"';
} else {
$ccopts = '';
}
@@ -275,14 +278,16 @@ for my $module (@modules) {
}}
}
-my $count = scalar @modules - $skip;
-log_diag("$count / $module_count modules tested with B-C-${B::C::VERSION} - "
- .$Config{usecperl}?"c":""."perl-$perlversion");
-log_diag(sprintf("pass %3d / %3d (%s)", $pass, $count, percent($pass,$count)));
-log_diag(sprintf("fail %3d / %3d (%s)", $fail, $count, percent($fail,$count)));
-log_diag(sprintf("todo %3d / %3d (%s)", $todo, $fail, percent($todo,$fail)));
-log_diag(sprintf("skip %3d / %3d (%s not installed)\n",
- $skip, $module_count, percent($skip,$module_count)));
+if (!$ENV{PERL_CORE}) {
+ my $count = scalar @modules - $skip;
+ log_diag("$count / $module_count modules tested with B-C-${B::C::VERSION} - "
+ .$Config{usecperl}?"c":""."perl-$perlversion");
+ log_diag(sprintf("pass %3d / %3d (%s)", $pass, $count, percent($pass,$count)));
+ log_diag(sprintf("fail %3d / %3d (%s)", $fail, $count, percent($fail,$count)));
+ log_diag(sprintf("todo %3d / %3d (%s)", $todo, $fail, percent($todo,$fail)));
+ log_diag(sprintf("skip %3d / %3d (%s not installed)\n",
+ $skip, $module_count, percent($skip,$module_count)));
+}
exit;
@@ -365,6 +370,10 @@ sub is_todo {
#)) { return '>= 5.22 with threads SEGV' if $_ eq $module; }}
#if ($] >= 5.022) { foreach(qw(
#)) { return '>= 5.22 with threads, no ok' if $_ eq $module; }}
+ # but works with msvc
+ if ($^O eq 'MSWin32' and $Config{cc} eq 'gcc') { foreach(qw(
+ Pod::Usage
+ )) { return 'mingw' if $_ eq $module; }}
} else { #no threads --------------------------------
#if ($] > 5.008008 and $] <= 5.009) { foreach(qw(
# ExtUtils::CBuilder
View
@@ -51,6 +51,7 @@ my $perldocexe = $^O eq 'MSWin32' ? "perldoc$exe" : "./perldoc$exe";
# XXX bother File::Which?
plan skip_all => "$perldoc not found" unless -f $perldoc;
plan skip_all => "MSVC" if ($^O eq 'MSWin32' and $Config{cc} eq 'cl');
+plan skip_all => "mingw" if ($^O eq 'MSWin32' and $Config{cc} eq 'gcc'); # fail 1,4
plan tests => 7;
# XXX interestingly 5.8 perlcc cannot compile perldoc because Cwd disturbs the method finding
View
@@ -1440,6 +1440,15 @@ tests[4002]='use Class::XSAccessor;
Class::XSAccessor->import(constructor => "new", accessors => [ "foo" ]);
my $o = main::->new( foo => "ok" );
print $o->foo,"\n";'
+tests[411]='#TODO run-time regcomp of \p{}
+our ( $q, $myre );
+BEGIN { $q = qr[\p{IsWord}] }
+eval q/$myre = qr[^$q]/; # add ^ to force the RegExp to be recompiled
+print qq[ok\n] if q[hello] =~ $myre;'
+tests[4111]='our ( $q, $myre );
+BEGIN { $q = qr[\p{IsWord}] }
+eval q/$myre = qr[$q]/; # this works
+print qq[ok\n] if q[hello] =~ $myre;'
init

0 comments on commit 78c2e44

Please sign in to comment.