diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/ExtUtils/typemap')
-rw-r--r-- | Master/tlpkg/tlperl/lib/ExtUtils/typemap | 54 |
1 files changed, 41 insertions, 13 deletions
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/typemap b/Master/tlpkg/tlperl/lib/ExtUtils/typemap index 0b09641f8d6..4bfba95e9e0 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/typemap +++ b/Master/tlpkg/tlperl/lib/ExtUtils/typemap @@ -378,7 +378,19 @@ T_PACKEDARRAY T_ARRAY { U32 ix_$var; - EXTEND(SP,size_$var); + SSize_t extend_size = + /* The weird way this is written is because g++ is dumb + * enough to warn "comparison is always false" on something + * like: + * + * sizeof(a) > sizeof(b) && a > B_t_MAX + * + * (where the LH condition is false) + */ + (size_$var > (sizeof(size_$var) > sizeof(SSize_t) + ? SSize_t_MAX : size_$var)) + ? -1 : (SSize_t)size_$var; + EXTEND(SP, extend_size); for (ix_$var = 0; ix_$var < size_$var; ix_$var++) { ST(ix_$var) = sv_newmortal(); DO_ARRAY_ELEM @@ -388,32 +400,48 @@ T_STDIO { GV *gv = newGVgen("$Package"); PerlIO *fp = PerlIO_importFILE($var,0); - if ( fp && do_open(gv, "+<&", 3, FALSE, 0, 0, fp) ) - sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); + if ( fp && do_open(gv, "+<&", 3, FALSE, 0, 0, fp) ) { + SV *rv = newRV_inc((SV*)gv); + rv = sv_bless(rv, GvSTASH(gv)); + ${"$var" eq "RETVAL" ? \"$arg = sv_2mortal(rv);" + : \"sv_setsv($arg, rv);\n\t\tSvREFCNT_dec_NN(rv);"} + }${"$var" ne "RETVAL" ? \" else - $arg = &PL_sv_undef; + sv_setsv($arg, &PL_sv_undef);\n" : \""} } T_IN { GV *gv = newGVgen("$Package"); - if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) ) - sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); + if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) ) { + SV *rv = newRV_inc((SV*)gv); + rv = sv_bless(rv, GvSTASH(gv)); + ${"$var" eq "RETVAL" ? \"$arg = sv_2mortal(rv);" + : \"sv_setsv($arg, rv);\n\t\tSvREFCNT_dec_NN(rv);"} + }${"$var" ne "RETVAL" ? \" else - $arg = &PL_sv_undef; + sv_setsv($arg, &PL_sv_undef);\n" : \""} } T_INOUT { GV *gv = newGVgen("$Package"); - if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) ) - sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); + if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) ) { + SV *rv = newRV_inc((SV*)gv); + rv = sv_bless(rv, GvSTASH(gv)); + ${"$var" eq "RETVAL" ? \"$arg = sv_2mortal(rv);" + : \"sv_setsv($arg, rv);\n\t\tSvREFCNT_dec_NN(rv);"} + }${"$var" ne "RETVAL" ? \" else - $arg = &PL_sv_undef; + sv_setsv($arg, &PL_sv_undef);\n" : \""} } T_OUT { GV *gv = newGVgen("$Package"); - if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) ) - sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); + if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) ) { + SV *rv = newRV_inc((SV*)gv); + rv = sv_bless(rv, GvSTASH(gv)); + ${"$var" eq "RETVAL" ? \"$arg = sv_2mortal(rv);" + : \"sv_setsv($arg, rv);\n\t\tSvREFCNT_dec_NN(rv);"} + }${"$var" ne "RETVAL" ? \" else - $arg = &PL_sv_undef; + sv_setsv($arg, &PL_sv_undef);\n" : \""} } |