X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FExtUtils%2Ftypemap;h=8377bd7cec9d61c85962ea7b9a7e7243f25a4add;hb=84a9aad5c224d0cf574731960d4cf03373a57222;hp=026067857072eed81765d9bbcb0b86671b775549;hpb=8593bda5eaf2f40ae7a609c286d223c8f721fc0d;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/ExtUtils/typemap b/lib/ExtUtils/typemap
index 0260678..8377bd7 100644
--- a/lib/ExtUtils/typemap
+++ b/lib/ExtUtils/typemap
@@ -10,6 +10,7 @@ char			T_CHAR
 unsigned char		T_U_CHAR
 char *			T_PV
 unsigned char *		T_PV
+const char *		T_PV
 caddr_t			T_PV
 wchar_t *		T_PV
 wchar_t			T_IV
@@ -18,7 +19,7 @@ size_t			T_IV
 ssize_t			T_IV
 time_t			T_NV
 unsigned long *		T_OPAQUEPTR
-char **			T_PACKED
+char **			T_PACKEDARRAY
 void *			T_PTR
 Time_t *		T_PV
 SV *			T_SV
@@ -29,18 +30,22 @@ CV *			T_CVREF
 
 IV			T_IV
 UV			T_UV
+NV                      T_NV
 I32			T_IV
 I16			T_IV
 I8			T_IV
+STRLEN			T_IV
 U32			T_U_LONG
 U16			T_U_SHORT
 U8			T_UV
 Result			T_U_CHAR
-Boolean			T_IV
+Boolean			T_BOOL
+float                   T_FLOAT
 double			T_DOUBLE
 SysRet			T_SYSRET
 SysRetLong		T_SYSRET
-FILE *			T_IN
+FILE *			T_STDIO
+PerlIO *		T_INOUT
 FileHandle		T_PTROBJ
 InputStream		T_IN
 InOutStream		T_INOUT
@@ -52,25 +57,25 @@ INPUT
 T_SV
 	$var = $arg
 T_SVREF
-	if (sv_isa($arg, \"${ntype}\"))
+	if (SvROK($arg))
 	    $var = (SV*)SvRV($arg);
 	else
-	    croak(\"$var is not of type ${ntype}\")
+	    Perl_croak(aTHX_ \"$var is not a reference\")
 T_AVREF
-	if (sv_isa($arg, \"${ntype}\"))
+	if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV)
 	    $var = (AV*)SvRV($arg);
 	else
-	    croak(\"$var is not of type ${ntype}\")
+	    Perl_croak(aTHX_ \"$var is not an array reference\")
 T_HVREF
-	if (sv_isa($arg, \"${ntype}\"))
+	if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVHV)
 	    $var = (HV*)SvRV($arg);
 	else
-	    croak(\"$var is not of type ${ntype}\")
+	    Perl_croak(aTHX_ \"$var is not a hash reference\")
 T_CVREF
-	if (sv_isa($arg, \"${ntype}\"))
+	if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVCV)
 	    $var = (CV*)SvRV($arg);
 	else
-	    croak(\"$var is not of type ${ntype}\")
+	    Perl_croak(aTHX_ \"$var is not a code reference\")
 T_SYSRET
 	$var NOT IMPLEMENTED
 T_UV
@@ -82,7 +87,7 @@ T_INT
 T_ENUM
 	$var = ($type)SvIV($arg)
 T_BOOL
-	$var = (int)SvIV($arg)
+	$var = (bool)SvTRUE($arg)
 T_U_INT
 	$var = (unsigned int)SvUV($arg)
 T_SHORT
@@ -94,7 +99,7 @@ T_LONG
 T_U_LONG
 	$var = (unsigned long)SvUV($arg)
 T_CHAR
-	$var = (char)*SvPV($arg,PL_na)
+	$var = (char)*SvPV_nolen($arg)
 T_U_CHAR
 	$var = (unsigned char)SvUV($arg)
 T_FLOAT
@@ -104,7 +109,7 @@ T_NV
 T_DOUBLE
 	$var = (double)SvNV($arg)
 T_PV
-	$var = ($type)SvPV($arg,PL_na)
+	$var = ($type)SvPV_nolen($arg)
 T_PTR
 	$var = INT2PTR($type,SvIV($arg))
 T_PTRREF
@@ -113,54 +118,54 @@ T_PTRREF
 	    $var = INT2PTR($type,tmp);
 	}
 	else
-	    croak(\"$var is not a reference\")
+	    Perl_croak(aTHX_ \"$var is not a reference\")
 T_REF_IV_REF
-	if (sv_isa($arg, \"${type}\")) {
+	if (sv_isa($arg, \"${ntype}\")) {
 	    IV tmp = SvIV((SV*)SvRV($arg));
-	    $var = *($type *) tmp;
+	    $var = *INT2PTR($type *, tmp);
 	}
 	else
-	    croak(\"$var is not of type ${ntype}\")
+	    Perl_croak(aTHX_ \"$var is not of type ${ntype}\")
 T_REF_IV_PTR
-	if (sv_isa($arg, \"${type}\")) {
+	if (sv_isa($arg, \"${ntype}\")) {
 	    IV tmp = SvIV((SV*)SvRV($arg));
-	    $var = ($type) tmp;
+	    $var = INT2PTR($type, tmp);
 	}
 	else
-	    croak(\"$var is not of type ${ntype}\")
+	    Perl_croak(aTHX_ \"$var is not of type ${ntype}\")
 T_PTROBJ
 	if (sv_derived_from($arg, \"${ntype}\")) {
 	    IV tmp = SvIV((SV*)SvRV($arg));
 	    $var = INT2PTR($type,tmp);
 	}
 	else
-	    croak(\"$var is not of type ${ntype}\")
+	    Perl_croak(aTHX_ \"$var is not of type ${ntype}\")
 T_PTRDESC
 	if (sv_isa($arg, \"${ntype}\")) {
 	    IV tmp = SvIV((SV*)SvRV($arg));
-	    ${type}_desc = (\U${type}_DESC\E*) tmp; 
+	    ${type}_desc = (\U${type}_DESC\E*) tmp;
 	    $var = ${type}_desc->ptr;
 	}
 	else
-	    croak(\"$var is not of type ${ntype}\")
+	    Perl_croak(aTHX_ \"$var is not of type ${ntype}\")
 T_REFREF
 	if (SvROK($arg)) {
 	    IV tmp = SvIV((SV*)SvRV($arg));
 	    $var = *INT2PTR($type,tmp);
 	}
 	else
-	    croak(\"$var is not a reference\")
+	    Perl_croak(aTHX_ \"$var is not a reference\")
 T_REFOBJ
 	if (sv_isa($arg, \"${ntype}\")) {
 	    IV tmp = SvIV((SV*)SvRV($arg));
 	    $var = *INT2PTR($type,tmp);
 	}
 	else
-	    croak(\"$var is not of type ${ntype}\")
+	    Perl_croak(aTHX_ \"$var is not of type ${ntype}\")
 T_OPAQUE
-	$var NOT IMPLEMENTED
+	$var = *($type *)SvPV_nolen($arg)
 T_OPAQUEPTR
-	$var = ($type)SvPV($arg,PL_na)
+	$var = ($type)SvPV_nolen($arg)
 T_PACKED
 	$var = XS_unpack_$ntype($arg)
 T_PACKEDARRAY
@@ -168,11 +173,16 @@ T_PACKEDARRAY
 T_CALLBACK
 	$var = make_perl_cb_$type($arg)
 T_ARRAY
-	$var = $ntype(items -= $argoff);
 	U32 ix_$var = $argoff;
+	$var = $ntype(items -= $argoff);
 	while (items--) {
 	    DO_ARRAY_ELEM;
+	    ix_$var++;
 	}
+        /* this is the number of elements in the array */
+        ix_$var -= $argoff
+T_STDIO
+	$var = PerlIO_findFILE(IoIFP(sv_2io($arg)))
 T_IN
 	$var = IoIFP(sv_2io($arg))
 T_INOUT
@@ -225,13 +235,13 @@ T_U_CHAR
 T_FLOAT
 	sv_setnv($arg, (double)$var);
 T_NV
-	sv_setnv($arg, (double)$var);
+	sv_setnv($arg, (NV)$var);
 T_DOUBLE
 	sv_setnv($arg, (double)$var);
 T_PV
 	sv_setpv((SV*)$arg, $var);
 T_PTR
-	sv_setiv($arg, (IV)$var);
+	sv_setiv($arg, PTR2IV($var));
 T_PTRREF
 	sv_setref_pv($arg, Nullch, (void*)$var);
 T_REF_IV_REF
@@ -243,8 +253,7 @@ T_PTROBJ
 T_PTRDESC
 	sv_setref_pv($arg, \"${ntype}\", (void*)new\U${type}_DESC\E($var));
 T_REFREF
-	sv_setrefref($arg, \"${ntype}\", XS_service_$ntype,
-		    ($var ? (void*)new $ntype($var) : 0));
+	NOT_IMPLEMENTED
 T_REFOBJ
 	NOT IMPLEMENTED
 T_OPAQUE
@@ -261,12 +270,23 @@ T_CALLBACK
 	sv_setpvn($arg, $var.context.value().chp(),
 		$var.context.value().size());
 T_ARRAY
-	ST_EXTEND($var.size);
-	for (U32 ix_$var = 0; ix_$var < $var.size; ix_$var++) {
+        {
+	    U32 ix_$var;
+	    EXTEND(SP,size_$var);
+	    for (ix_$var = 0; ix_$var < size_$var; ix_$var++) {
 		ST(ix_$var) = sv_newmortal();
 	DO_ARRAY_ELEM
+	    }
+        }
+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)));
+	    else
+		$arg = &PL_sv_undef;
 	}
-	SP += $var.size - 1;
 T_IN
 	{
 	    GV *gv = newGVgen("$Package");