X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=universal.c;h=868fe5514000c79ced23ce46d6121a0c1ad793f5;hb=52a55424e4624fc79eb8894fb91c5e2f4a9018ab;hp=3e14a68bd7d4dffe0f8e90675a58aa5dfe21f4e5;hpb=1b026014ba0f5424fabe070eda050db5e7df518a;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/universal.c b/universal.c
index 3e14a68..868fe55 100644
--- a/universal.c
+++ b/universal.c
@@ -132,9 +132,9 @@ Perl_sv_derived_from(pTHX_ SV *sv, const char *name)
 
 #include "XSUB.h"
 
-void XS_UNIVERSAL_isa(pTHXo_ CV *cv);
-void XS_UNIVERSAL_can(pTHXo_ CV *cv);
-void XS_UNIVERSAL_VERSION(pTHXo_ CV *cv);
+void XS_UNIVERSAL_isa(pTHX_ CV *cv);
+void XS_UNIVERSAL_can(pTHX_ CV *cv);
+void XS_UNIVERSAL_VERSION(pTHX_ CV *cv);
 XS(XS_utf8_valid);
 XS(XS_utf8_encode);
 XS(XS_utf8_decode);
@@ -142,6 +142,7 @@ XS(XS_utf8_upgrade);
 XS(XS_utf8_downgrade);
 XS(XS_utf8_unicode_to_native);
 XS(XS_utf8_native_to_unicode);
+XS(XS_access_readonly);
 
 void
 Perl_boot_core_UNIVERSAL(pTHX)
@@ -158,6 +159,7 @@ Perl_boot_core_UNIVERSAL(pTHX)
     newXS("utf8::downgrade", XS_utf8_downgrade, file);
     newXS("utf8::native_to_unicode", XS_utf8_native_to_unicode, file);
     newXS("utf8::unicode_to_native", XS_utf8_unicode_to_native, file);
+    newXSproto("access::readonly",XS_access_readonly, file, "\\[$%@];$");
 }
 
 
@@ -305,7 +307,7 @@ XS(XS_UNIVERSAL_VERSION)
 
 	if (SvNV(req) > SvNV(sv))
 	    Perl_croak(aTHX_ "%s version %s required--this is only version %s",
-		  HvNAME(pkg), SvPV(req,len), SvPV(sv,len));
+		       HvNAME(pkg), SvPV_nolen(req), SvPV_nolen(sv));
     }
 
 finish:
@@ -405,6 +407,10 @@ XS(XS_utf8_native_to_unicode)
 {
  dXSARGS;
  UV uv = SvUV(ST(0));
+
+ if (items > 1)
+     Perl_croak(aTHX_ "Usage: utf8::native_to_unicode(sv)");
+
  ST(0) = sv_2mortal(newSViv(NATIVE_TO_UNI(uv)));
  XSRETURN(1);
 }
@@ -413,8 +419,30 @@ XS(XS_utf8_unicode_to_native)
 {
  dXSARGS;
  UV uv = SvUV(ST(0));
+
+ if (items > 1)
+     Perl_croak(aTHX_ "Usage: utf8::unicode_to_native(sv)");
+
  ST(0) = sv_2mortal(newSViv(UNI_TO_NATIVE(uv)));
  XSRETURN(1);
 }
 
+XS(XS_access_readonly)
+{
+    dXSARGS;
+    SV *sv = SvRV(ST(0));
+    IV old = SvREADONLY(sv);
+    if (items == 2) {
+	if (SvTRUE(ST(1))) {
+	    SvREADONLY_on(sv);
+	}
+	else {
+	    SvREADONLY_off(sv);
+	}
+    }
+    if (old)
+	XSRETURN_YES;
+    else
+	XSRETURN_NO;
+}