Permalink
Browse files

C: Refine and fix prev commit 1.42_62

add proper testcase t/issue256.t
simplify sv_setpv/iv to sv_setpv_mg
ditto for $0 and $^X
  • Loading branch information...
1 parent 79fa41c commit 18c3cca7a42956d8463a841070a86ff31ec8b05e Reini Urban committed Dec 5, 2013
Showing with 73 additions and 46 deletions.
  1. +24 −45 lib/B/C.pm
  2. +48 −0 t/issue256.t
  3. +1 −1 t/testc.sh
View
@@ -1429,7 +1429,7 @@ sub B::COP::save {
# Trim the .pl extension, to print the executable name only.
my $file = $op->file;
- $file =~ s/\.pl$/.c/;
+ # $file =~ s/\.pl$/.c/;
if ($PERL512) {
if ($ITHREADS and $] >= 5.017) {
$copsect->comment(
@@ -5074,70 +5074,49 @@ _EOT14
_EOT15
if ($use_perl_script_name) {
- my $dollar_0 = $0;
- $dollar_0 =~ s/\\/\\\\/g;
- $dollar_0 = '"' . $dollar_0 . '"';
-
- print <<"EOT";
- if ((tmpgv = gv_fetchpv("0", GV_ADD, SVt_PV))) {/* $0 */
- tmpsv = GvSVn(tmpgv);
- sv_setpv(tmpsv, ${dollar_0});
- SvSETMAGIC(tmpsv);
- }
-EOT
-
+ my $dollar_0 = cstring($0);
+ print sprintf(qq{ sv_setpv_mg(get_sv("0", GV_ADD|GV_NOTQUAL), %s);\n}, $dollar_0);
+ print sprintf(qq{ CopFILE_set(&PL_compiling, %s);\n}, $dollar_0);
}
else {
- print <<"EOT";
- if ((tmpgv = gv_fetchpv("0", GV_ADD, SVt_PV))) {/* $0 */
- tmpsv = GvSVn(tmpgv);
- sv_setpv(tmpsv, argv[0]);
- SvSETMAGIC(tmpsv);
- CopFILE_set(&PL_compiling, argv[0]);
- }
-EOT
-
+ print qq{ sv_setpv_mg(get_sv("0", GV_ADD|GV_NOTQUAL), argv[0]);\n};
+ print qq{ CopFILE_set(&PL_compiling, argv[0]);\n};
}
# more global vars
print " PL_hints = $^H;\n" if $^H;
print " PL_unicode = ${^UNICODE};\n" if ${^UNICODE};
print " PL_utf8locale = ${^UTF8LOCALE};\n" if ${^UTF8LOCALE};
# nomg
- print sprintf(qq{ sv_setpvs(get_sv(";",0), %s);\n}, cstring($;)) if $; ne "\34";
- print sprintf(qq{ sv_setpvs(get_sv("\"", 0), %s);\n}, cstring($")) if $" ne " ";
+ print sprintf(qq{ sv_setpv(get_sv(";", GV_ADD|GV_NOTQUAL), %s);\n}, cstring($;)) if $; ne "\34";
+ print sprintf(qq{ sv_setpv(get_sv("\"", GV_NOTQUAL), %s);\n}, cstring($")) if $" ne " ";
# global IO vars
- print sprintf(qq{ {SV* s = GvSVn(PL_ofsgv); sv_setpv(s, %s); mg_set(s);}\n}, cstring($,)) if $,;
- print sprintf(qq{ {SV* s = get_sv("/", 0); sv_setpvs(s, %s); mg_set(s);}\n}, cstring($/)) if $/ ne "\n"; #RS
- print sprintf(qq{ {SV* s = get_sv("\\",GV_ADD); sv_setpvs(s, %s); mg_set(s);}\n}, cstring($\)) if $\; #ORS
- print qq{ {SV* s = get_sv("|",GV_ADD); sv_setiv(s, $|); mg_set(s);}\n} if $|; #OUTPUT_AUTOFLUSH
+ print sprintf(qq{ sv_setpv_mg(GvSVn(PL_ofsgv), %s);\n}, cstring($,)) if $,;
+ print sprintf(qq{ sv_setpv_mg(get_sv("/", GV_NOTQUAL), %s);\n}, cstring($/)) if $/ ne "\n"; #RS
+ print sprintf(qq{ sv_setpv_mg(get_sv("\\", GV_ADD|GV_NOTQUAL), %s);\n}, cstring($\)) if $\; #ORS
+ print qq{ sv_setiv_mg(get_sv("|", GV_ADD|GV_NOTQUAL), $|);\n} if $|; #OUTPUT_AUTOFLUSH
# global format vars
- print sprintf(qq{ {SV* s = get_sv("^A",GV_ADD); sv_setpvs(s, %s); mg_set(s);}\n}, cstring($^A)) if $^A; #ACCUMULATOR
- print sprintf(qq{ {SV* s = get_sv("^L",GV_ADD); sv_setpvs(s, %s); mg_set(s);}\n}, cstring($^L)) if $^L ne "\f"; #FORMFEED
- print sprintf(qq{ {SV* s = get_sv(":",GV_ADD); sv_setpvs(s, %s); mg_set(s);}\n}, cstring($:)) if $: ne " \n-"; #LINE_BREAK_CHARACTERS
- print sprintf(qq{ {SV* s = get_sv("^",0); sv_setpvs(s, %s); mg_set(s);}\n}, cstring($^)) if $^ ne "STDOUT_TOP";
- print sprintf(qq{ {SV* s = get_sv("~",0); sv_setpvs(s, %s); mg_set(s);}\n}, cstring($~)) if $~ ne "STDOUT";
- print qq{ {SV* s = get_sv("%",GV_ADD); sv_setiv(s, $%); mg_set(s);}\n} if $%; #PAGE_NUMBER
- print qq{ {SV* s = get_sv("-",GV_ADD); sv_setiv(s, $-); mg_set(s);}\n} if $-; #LINES_LEFT
- print qq{ {SV* s = get_sv("=",0); sv_setiv(s, $=); mg_set(s);}\n} if $= != 60; #LINES_PER_PAGE
+ print sprintf(qq{ sv_setpv_mg(get_sv("^A", GV_ADD|GV_NOTQUAL), %s);\n}, cstring($^A)) if $^A; #ACCUMULATOR
+ print sprintf(qq{ sv_setpv_mg(get_sv("^L", GV_ADD|GV_NOTQUAL), %s);\n}, cstring($^L)) if $^L ne "\f"; #FORMFEED
+ print sprintf(qq{ sv_setpv_mg(get_sv(":", GV_ADD|GV_NOTQUAL), %s);\n}, cstring($:)) if $: ne " \n-"; #LINE_BREAK_CHARACTERS
+ print sprintf(qq{ sv_setpv_mg(get_sv("^", GV_ADD|GV_NOTQUAL), %s);\n}, cstring($^)) if $^ ne "STDOUT_TOP";
+ print sprintf(qq{ sv_setpv_mg(get_sv("~", GV_ADD|GV_NOTQUAL), %s);\n}, cstring($~)) if $~ ne "STDOUT";
+ print qq{ sv_setiv_mg(get_sv("%", GV_ADD|GV_NOTQUAL), $%);\n} if $%; #PAGE_NUMBER
+ print qq{ sv_setiv_mg(get_sv("-", GV_ADD|GV_NOTQUAL), $-);\n} if $-; #LINES_LEFT
+ print qq{ sv_setiv_mg(get_sv("=", GV_ADD|GV_NOTQUAL), $=);\n} if $= != 60; #LINES_PER_PAGE
# deprecated global vars
- print qq{ {SV* s = get_sv("[",0); sv_setiv(s, $[); mg_set(s);}\n} if $[; #ARRAY_BASE
+ print qq{ {SV* s = get_sv("[",GV_NOTQUAL); sv_setiv(s, $[); mg_set(s);}\n} if $[; #ARRAY_BASE
if ($] < 5.010) { # OFMT and multiline matching
eval q[
- print sprintf(qq{ sv_setpv(GvSVn(gv_fetchpv("\$#",GV_ADD|GV_NOTQUAL, SVt_PV)), %s);\n},
+ print sprintf(qq{ sv_setpv(GvSVn(gv_fetchpv("\$#", GV_ADD|GV_NOTQUAL, SVt_PV)), %s);\n},
cstring($#)) if $#;
- print sprintf(qq{ sv_setiv(GvSVn(gv_fetchpv("\$*",GV_ADD|GV_NOTQUAL, SVt_IV)), %d);\n}, $*) if $*;
+ print sprintf(qq{ sv_setiv(GvSVn(gv_fetchpv("\$*", GV_ADD|GV_NOTQUAL, SVt_IV)), %d);\n}, $*) if $*;
];
}
my $X = $^X =~ /[\s\\]/ ? B::cchar($^X) : $^X;
+ print sprintf(qq{ sv_setpv_mg(get_sv("\030", GV_ADD|GV_NOTQUAL), "%s"); /* $^X */\n}, $X);
print <<"EOT";
- if ((tmpgv = gv_fetchpv("\030", GV_ADD|GV_NOTQUAL, SVt_PV))) {/* $^X */
- tmpsv = GvSVn(tmpgv);
- sv_setpv(tmpsv,"$X");
- SvSETMAGIC(tmpsv);
- }
-
TAINT_NOT;
#if PERL_VERSION < 10 || ((PERL_VERSION == 10) && (PERL_SUBVERSION < 1))
View
@@ -0,0 +1,48 @@
+#! /usr/bin/env perl
+# http://code.google.com/p/perl-compiler/issues/detail?id=256
+# initialize all global vars
+use strict;
+BEGIN {
+ unshift @INC, 't';
+ require "test.pl";
+}
+my $pv_vars = {';' => "\34",
+ '"' => " ",
+ #"\\" => undef,
+ #',' => undef,
+ '/' => "/n",
+ '^A' => undef,
+ '^L' => "\f",
+ ':' => " \n-",
+ '^' => "STDOUT_TOP",
+ '~' => "STDOUT"};
+my $iv_vars = {'^H' => 0,
+ '|' => 0,
+ '%' => 0,
+ '-' => 0,
+ '=' => 60,
+ #'{^UNICODE}' => 0,
+ #'{^UTF8LOCALE}' => 1
+ };
+use Test::More tests => 2;
+
+my $script = '';
+$script .= sprintf('BEGIN{ $%s = "a"} $%s = "a"; print qq{not ok - \$%s = $%s\n} if $%s ne "a";'."\n",
+ $_, $_, $_, $_, $_) for keys %$pv_vars;
+$script .= sprintf('BEGIN{ $%s = 1} $%s = 1; print qq{not ok - \$%s = $%s\n} if $%s != 1;'."\n",
+ $_, $_, $_, $_, $_) for keys %$iv_vars;
+$script .= 'BEGIN{ $\\ = "\n"; } $\\ = "\n"; print qq{not ok - \$\\ = $\\\n} if $\\ ne "\n";'."\n";
+$script .= qq(print "ok\\n";);
+
+ctestok(1,'C,-O3','ccode256i',$script,'#256 initialize most global vars');
+ctestok(2,'C,-O3','ccode256i',
+ 'BEGIN{$, = " "; } $, = " "; print $, eq " " ? "ok\n" : qq{not ok - \$, = $,\n}',
+ '#256 initialize $,');
+
+# TODO: need -C switches to set the rest
+#ctestok(3,'C,-O3','ccode256i',
+# 'BEGIN{ ${^UNICODE} = 15; } ${^UNICODE} = 15; print qq{not ok - \${^UNICODE} = ${^UNICODE}\n} if ${^UNICODE} != 15;',
+# '#256 initialize ${^UNICODE}');
+#ctestok(4,'C,-O3','ccode256i',
+# 'BEGIN{ ${^UTF8LOCALE} = 2; } ${^UTF8LOCALE} = 2; print ${^UTF8LOCALE} == 2 ? "ok\n" : qq{not ok - \${^UTF8LOCALE} = ${^UTF8LOCALE}\n};',
+# '#256 initialize ${^UTF8LOCALE}');
View
@@ -953,7 +953,7 @@ result[232]='ok'
tests[234]='$c = 0; for ("-3" .. "0") { $c++ } ; print "$c"'
result[234]='4'
# t/testc.sh -O3 -Dp,-UCarp,-v 235
-tests[235]='BEGIN{$INC{Carp.pm}++} $d = pack("U*", 0xe3, 0x81, 0xAF); { use bytes; $ol = bytes::length($d) } print $ol'
+tests[235]='BEGIN{$INC{"Carp.pm"}="/dev/null"} $d = pack("U*", 0xe3, 0x81, 0xAF); { use bytes; $ol = bytes::length($d) } print $ol'
result[235]='6'
# -O3
tests[236]='sub t { if ($_[0] == $_[1]) { print "ok\n"; } else { print "not ok - $_[0] == $_[1]\n"; } } t(-1.2, " -1.2");'

0 comments on commit 18c3cca

Please sign in to comment.