summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/ExtUtils/typemap
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/ExtUtils/typemap')
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/typemap54
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" : \""}
}