Implement handling of state variables in list assignment

[p5sagit/p5-mst-13.2.git] / ext / B / B / C.pm

diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm
index 906c1a4..17ca257 100644 (file)
--- a/ext/B/B/C.pm
+++ b/ext/B/B/C.pm
@@ -8,7 +8,7 @@
 
 package B::C;
 
-our $VERSION = '1.04';
+our $VERSION = '1.05';
 
 package B::C::Section;
 
@@ -659,7 +659,7 @@ sub savepvn {
     # work with byte offsets/lengths
     my $pv = pack "a*", $pv;
     if (defined $max_string_len && length($pv) > $max_string_len) {
-       push @res, sprintf("New(0,%s,%u,char);", $dest, length($pv)+1);
+       push @res, sprintf("Newx(%s,%u,char);", $dest, length($pv)+1);
        my $offset = 0;
        while (length $pv) {
            my $str = substr $pv, 0, $max_string_len, '';
@@ -1182,14 +1182,19 @@ sub B::AV::save {
     my ($av) = @_;
     my $sym = objsym($av);
     return $sym if defined $sym;
-    $xpvavsect->add(sprintf("0, -1, -1, 0, 0.0, 0, Nullhv, 0, 0"));
+    my $line = "0, -1, -1, 0, 0.0, 0, Nullhv, 0, 0";
+    $line .= sprintf(", 0x%x", $av->AvFLAGS) if $] < 5.009;
+    $xpvavsect->add($line);
     $svsect->add(sprintf("&xpvav_list[%d], %lu, 0x%x",
                         $xpvavsect->index, $av->REFCNT  , $av->FLAGS));
     my $sv_list_index = $svsect->index;
     my $fill = $av->FILL;
     $av->save_magic;
-    warn sprintf("saving AV 0x%x FILL=$fill", $$av)
-       if $debug_av;
+    if ($debug_av) {
+       $line = sprintf("saving AV 0x%x FILL=$fill", $$av);
+       $line .= sprintf(" AvFLAGS=0x%x", $av->AvFLAGS) if $] < 5.009;
+       warn $line;
+    }
     # XXX AVf_REAL is wrong test: need to save comppadlist but not stack
     #if ($fill > -1 && ($avflags & AVf_REAL)) {
     if ($fill > -1) {
@@ -1411,47 +1416,11 @@ sub output_declarations {
 #endif /* BROKEN_STATIC_REDECL */
 
 #ifdef BROKEN_UNION_INIT
-/*
- * Cribbed from cv.h with ANY (a union) replaced by void*.
- * Some pre-Standard compilers can't cope with initialising unions. Ho hum.
- */
-typedef struct {
-    char *     xpv_pv;         /* pointer to malloced string */
-    STRLEN     xpv_cur;        /* length of xp_pv as a C string */
-    STRLEN     xpv_len;        /* allocated size */
-    IV         xof_off;        /* integer value */
-    NV         xnv_nv;         /* numeric value, if any */
-    MAGIC*     xmg_magic;      /* magic for scalar array */
-    HV*                xmg_stash;      /* class package */
-
-    HV *       xcv_stash;
-    OP *       xcv_start;
-    OP *       xcv_root;
-    void      (*xcv_xsub) (pTHX_ CV*);
-    ANY                xcv_xsubany;
-    GV *       xcv_gv;
-    char *     xcv_file;
-    long       xcv_depth;      /* >= 2 indicates recursive call */
-    AV *       xcv_padlist;
-    CV *       xcv_outside;
-EOT
-    print <<'EOT' if $] < 5.009;
-#ifdef USE_5005THREADS
-    perl_mutex *xcv_mutexp;
-    struct perl_thread *xcv_owner;     /* current owner thread */
-#endif /* USE_5005THREADS */
-EOT
-    print <<'EOT';
-    cv_flags_t xcv_flags;
-    U32                xcv_outside_seq; /* the COP sequence (at the point of our
-                                 * compilation) in the lexically enclosing
-                                 * sub */
-} XPVCV_or_similar;
-#define ANYINIT(i) i
-#else
+#error BROKEN_UNION_INIT no longer needed, as Perl requires an ANSI compiler
+#endif
+
 #define XPVCV_or_similar XPVCV
 #define ANYINIT(i) {i}
-#endif /* BROKEN_UNION_INIT */
 #define Nullany ANYINIT(0)
 
 #define UNUSED 0
@@ -1580,7 +1549,7 @@ EOT
 #else
 #define EXTRA_OPTIONS 4
 #endif /* ALLOW_PERL_OPTIONS */
-    New(666, fakeargv, argc + EXTRA_OPTIONS + 1, char *);
+    Newx(fakeargv, argc + EXTRA_OPTIONS + 1, char *);
 
     fakeargv[0] = argv[0];
     fakeargv[1] = "-e";