Upgrade Digest::MD5 from version 2.40 to 2.50

8 files changed, 147 insertions, 77 deletions

diff --git a/cpan/Digest-MD5/Changes b/cpan/Digest-MD5/Changes
index 756716c7b2..10e98b76f2 100644
--- a/cpan/Digest-MD5/Changes
+++ b/cpan/Digest-MD5/Changes
@@ -1,3 +1,23 @@
+2010-09-25   Gisle Aas <gisle@ActiveState.com>
+
+   Release 2.50
+
+   Chris 'BinGOs' Williams (1):
+      Amended tests to work with perl core.
+
+   Florian Ragwitz (3):
+      Attach context pointers using sv magic
+      Add failing test for thread cloning
+      Clone MD5 contexts on thread cloning
+
+   Gisle Aas (1):
+      perl-5.6 no longer supported
+
+   Jesse Vincent (1):
+      Preserve utf8ness of argument [RT#44927]
+
+
+
 2010-07-03   Gisle Aas <gisle@ActiveState.com>
 
    Release 2.40
diff --git a/cpan/Digest-MD5/MD5.pm b/cpan/Digest-MD5/MD5.pm
index ca17ad4135..978eefadc0 100644
--- a/cpan/Digest-MD5/MD5.pm
+++ b/cpan/Digest-MD5/MD5.pm
@@ -3,7 +3,7 @@ package Digest::MD5;
 use strict;
 use vars qw($VERSION @ISA @EXPORT_OK);
 
-$VERSION = '2.40';
+$VERSION = '2.50';
 
 require Exporter;
 *import = \&Exporter::import;
diff --git a/cpan/Digest-MD5/MD5.xs b/cpan/Digest-MD5/MD5.xs
index 89e39d2399..ac36b055d1 100644
--- a/cpan/Digest-MD5/MD5.xs
+++ b/cpan/Digest-MD5/MD5.xs
@@ -43,50 +43,6 @@ extern "C" {
 }
 #endif
 
-#ifndef PERL_VERSION
-#    include <patchlevel.h>
-#    if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL)))
-#        include <could_not_find_Perl_patchlevel.h>
-#    endif
-#    define PERL_REVISION       5
-#    define PERL_VERSION        PATCHLEVEL
-#    define PERL_SUBVERSION     SUBVERSION
-#endif
-
-#if PERL_VERSION <= 4 && !defined(PL_dowarn)
-   #define PL_dowarn dowarn
-#endif
-
-#ifdef G_WARN_ON
-   #define DOWARN (PL_dowarn & G_WARN_ON)
-#else
-   #define DOWARN PL_dowarn
-#endif
-
-#ifdef SvPVbyte
-   #if PERL_REVISION == 5 && PERL_VERSION < 7
-       /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */
-       #undef SvPVbyte
-       #define SvPVbyte(sv, lp) \
-	  ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
-     	   ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp))
-
-       static char *
-       my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
-       {
-	   sv_utf8_downgrade(sv,0);
-           return SvPV(sv,*lp);
-       }
-   #endif
-#else
-   #define SvPVbyte SvPV
-#endif
-
-#ifndef dTHX
-   #define pTHX_
-   #define aTHX_
-#endif
-
 /* Perl does not guarantee that U32 is exactly 32 bits.  Some system
  * has no integral type with exactly 32 bits.  For instance, A Cray has
  * short, int and long all at 64 bits so we need to apply this macro
@@ -133,18 +89,48 @@ static void u2s(U32 u, U8* s)
                         ((U32)(*(s+3)) << 24))
 #endif
 
-#define MD5_CTX_SIGNATURE 200003165
-
 /* This stucture keeps the current state of algorithm.
  */
 typedef struct {
-  U32 signature;   /* safer cast in get_md5_ctx() */
   U32 A, B, C, D;  /* current digest */
   U32 bytes_low;   /* counts bytes in message */
   U32 bytes_high;  /* turn it into a 64-bit counter */
   U8 buffer[128];  /* collect complete 64 byte blocks */
 } MD5_CTX;
 
+#ifdef USE_ITHREADS
+STATIC int dup_md5_ctx(pTHX_ MAGIC *mg, CLONE_PARAMS *params)
+{
+    MD5_CTX *new_ctx;
+    PERL_UNUSED_VAR(params);
+    New(55, new_ctx, 1, MD5_CTX);
+    memcpy(new_ctx, mg->mg_ptr, sizeof(MD5_CTX));
+    mg->mg_ptr = (char *)new_ctx;
+    return 0;
+}
+#endif
+
+STATIC MGVTBL vtbl_md5 = {
+    NULL, /* get */
+    NULL, /* set */
+    NULL, /* len */
+    NULL, /* clear */
+    NULL, /* free */
+#ifdef MGf_COPY
+    NULL, /* copy */
+#endif
+#ifdef MGf_DUP
+# ifdef USE_ITHREADS
+    dup_md5_ctx,
+# else
+    NULL, /* dup */
+# endif
+#endif
+#ifdef MGf_LOCAL
+    NULL /* local */
+#endif
+};
+
 
 /* Padding is added at the end of the message in order to fill a
  * complete 64 byte block (- 8 bytes for the message length).  The
@@ -466,19 +452,43 @@ MD5Final(U8* digest, MD5_CTX *ctx)
 
 static MD5_CTX* get_md5_ctx(pTHX_ SV* sv)
 {
-    if (SvROK(sv)) {
-	sv = SvRV(sv);
-	if (SvIOK(sv)) {
-	    MD5_CTX* ctx = INT2PTR(MD5_CTX*, SvIV(sv));
-	    if (ctx && ctx->signature == MD5_CTX_SIGNATURE) {
-		return ctx;
-            }
-        }
+    MAGIC *mg;
+
+    if (!sv_derived_from(sv, "Digest::MD5"))
+	croak("Not a reference to a Digest::MD5 object");
+
+    for (mg = SvMAGIC(SvRV(sv)); mg; mg = mg->mg_moremagic) {
+	if (mg->mg_type == PERL_MAGIC_ext && mg->mg_virtual == &vtbl_md5) {
+	    return (MD5_CTX *)mg->mg_ptr;
+	}
     }
-    croak("Not a reference to a Digest::MD5 object");
+
+    croak("Failed to get MD5_CTX pointer");
     return (MD5_CTX*)0; /* some compilers insist on a return value */
 }
 
+static SV * new_md5_ctx(pTHX_ MD5_CTX *context, const char *klass)
+{
+    SV *sv = newSV(0);
+    SV *obj = newRV_noinc(sv);
+#ifdef USE_ITHREADS
+    MAGIC *mg;
+#endif
+
+    sv_bless(obj, gv_stashpv(klass, 0));
+
+#ifdef USE_ITHREADS
+    mg =
+#endif
+	sv_magicext(sv, NULL, PERL_MAGIC_ext, &vtbl_md5, (void *)context, 0);
+
+#ifdef USE_ITHREADS
+    mg->mg_flags |= MGf_DUP;
+#endif
+
+    return obj;
+}
+
 
 static char* hex_16(const unsigned char* from, char* to)
 {
@@ -568,16 +578,13 @@ new(xclass)
     PPCODE:
 	if (!SvROK(xclass)) {
 	    STRLEN my_na;
-	    char *sclass = SvPV(xclass, my_na);
+	    const char *sclass = SvPV(xclass, my_na);
 	    New(55, context, 1, MD5_CTX);
-	    context->signature = MD5_CTX_SIGNATURE;
-	    ST(0) = sv_newmortal();
-	    sv_setref_pv(ST(0), sclass, (void*)context);
-	    SvREADONLY_on(SvRV(ST(0)));
+	    ST(0) = sv_2mortal(new_md5_ctx(aTHX_ context, sclass));
 	} else {
 	    context = get_md5_ctx(aTHX_ xclass);
 	}
-        MD5Init(context);
+	MD5Init(context);
 	XSRETURN(1);
 
 void
@@ -589,9 +596,7 @@ clone(self)
 	MD5_CTX* context;
     PPCODE:
 	New(55, context, 1, MD5_CTX);
-	ST(0) = sv_newmortal();
-	sv_setref_pv(ST(0), myname , (void*)context);
-	SvREADONLY_on(SvRV(ST(0)));
+	ST(0) = sv_2mortal(new_md5_ctx(aTHX_ context, myname));
 	memcpy(context,cont,sizeof(MD5_CTX));
 	XSRETURN(1);
 
@@ -611,8 +616,10 @@ add(self, ...)
 	STRLEN len;
     PPCODE:
 	for (i = 1; i < items; i++) {
+            U32 had_utf8 = SvUTF8(ST(i));
 	    data = (unsigned char *)(SvPVbyte(ST(i), len));
 	    MD5Update(context, data, len);
+	    if (had_utf8) sv_utf8_upgrade(ST(i));
 	}
 	XSRETURN(1);  /* self */
 
@@ -693,7 +700,7 @@ md5(...)
     PPCODE:
 	MD5Init(&ctx);
 
-	if (DOWARN) {
+	if (PL_dowarn & G_WARN_ON) {
             const char *msg = 0;
 	    if (items == 1) {
 		if (SvROK(ST(0))) {
@@ -705,7 +712,7 @@ md5(...)
 		}
 	    }
 	    else if (items > 1) {
-		data = (unsigned char *)SvPVbyte(ST(0), len);
+		data = (unsigned char *)SvPV(ST(0), len);
 		if (len == 11 && memEQ("Digest::MD5", data, 11)) {
 		    msg = "probably called as class method";
 		}
@@ -723,8 +730,10 @@ md5(...)
 	}
 
 	for (i = 0; i < items; i++) {
+            U32 had_utf8 = SvUTF8(ST(i));
 	    data = (unsigned char *)(SvPVbyte(ST(i), len));
 	    MD5Update(&ctx, data, len);
+	    if (had_utf8) sv_utf8_upgrade(ST(i));
 	}
 	MD5Final(digeststr, &ctx);
         ST(0) = make_mortal_sv(aTHX_ digeststr, ix);
diff --git a/cpan/Digest-MD5/Makefile.PL b/cpan/Digest-MD5/Makefile.PL
index f8fd182737..69b2ed099a 100644
--- a/cpan/Digest-MD5/Makefile.PL
+++ b/cpan/Digest-MD5/Makefile.PL
@@ -16,7 +16,6 @@ if ($^O eq 'VMS') {
     }
 }
 
-push(@extra, 'INSTALLDIRS'  => 'perl') if $] >= 5.008;
 
 WriteMakefile(
     'NAME'	   => 'Digest::MD5',
@@ -24,7 +23,7 @@ WriteMakefile(
     'ABSTRACT'     => 'Perl interface to the MD-5 algorithm',
     'AUTHOR'       => 'Gisle Aas <gisle@activestate.com>',
     'LICENSE'      => 'perl',
-    'MIN_PERL_VERSION' => 5.006,
+    'MIN_PERL_VERSION' => 5.008,
     'PREREQ_PM'    => { 'File::Spec' => 0,
 			'Digest::base' => '1.00',
 			'XSLoader' => 0,
@@ -32,8 +31,8 @@ WriteMakefile(
     'META_MERGE'   => {
         repository => 'http://github.com/gisle/digest-md5',
     },
+    'INSTALLDIRS'  => 'perl',
     @extra,
-    'dist'         => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
 );
 
 
diff --git a/cpan/Digest-MD5/README b/cpan/Digest-MD5/README
index 3c48079a3d..45c3658b62 100644
--- a/cpan/Digest-MD5/README
+++ b/cpan/Digest-MD5/README
@@ -4,7 +4,7 @@ algorithm takes as input a message of arbitrary length and produces as
 output a 128-bit "fingerprint" or "message digest" of the input.
 MD5 is described in RFC 1321.
 
-You will need perl version 5.6 or better to install this module.
+You will need perl version 5.8 or better to install this module.
 
 Copyright 1998-2003 Gisle Aas.
 Copyright 1995-1996 Neil Winton.
diff --git a/cpan/Digest-MD5/t/files.t b/cpan/Digest-MD5/t/files.t
index 54cf4f4cb7..854e76f054 100644
--- a/cpan/Digest-MD5/t/files.t
+++ b/cpan/Digest-MD5/t/files.t
@@ -13,15 +13,15 @@ use Digest::MD5 qw(md5 md5_hex md5_base64);
 my $EXPECT;
 if (ord "A" == 193) { # EBCDIC
     $EXPECT = <<EOT;
-11e8028ee426273db6b6db270a8bb38c  README
-c13b305ff761095dea11ea1e74e5c7ec  MD5.xs
+4f932585bed0cc942186fb51daff4839  README
+7c769233985659318efbbb64f38d0ebd  MD5.xs
 276da0aa4e9a08b7fe09430c9c5690aa  rfc1321.txt
 EOT
 } else {
     # This is the output of: 'md5sum README MD5.xs rfc1321.txt'
     $EXPECT = <<EOT;
-c95549c6c5e1e1c078b27042f1dc850f  README
-4ae6c261478df35a192cc1bdffd5211f  MD5.xs
+c8d3f8457a2d6983253d771ffddb9f4c  README
+dab5596ff82930da5cdf75afcd255f9c  MD5.xs
 754b9db19f79dbc4992f7166eb0f37ce  rfc1321.txt
 EOT
 }
diff --git a/cpan/Digest-MD5/t/threads.t b/cpan/Digest-MD5/t/threads.t
new file mode 100644
index 0000000000..968fd0c2f4
--- /dev/null
+++ b/cpan/Digest-MD5/t/threads.t
@@ -0,0 +1,24 @@
+use strict;
+use warnings;
+use Test::More;
+use Config;
+
+BEGIN {
+    plan skip_all => 'Perl compiled without ithreads'
+        unless $Config{useithreads};
+    plan tests => 2;
+}
+
+use threads;
+use Digest::MD5;
+
+my $module = 'Digest::MD5';
+
+my $obj = $module->new;
+$obj->add("foo");
+my $tdigest = threads->create(sub { $obj->add("bar"); $obj->hexdigest })->join;
+
+isnt $obj->clone->hexdigest, $tdigest, "unshared object unaffected by the thread";
+
+$obj->add("bar");
+is $obj->clone->hexdigest, $tdigest;
diff --git a/cpan/Digest-MD5/t/utf8.t b/cpan/Digest-MD5/t/utf8.t
index 6cf68b7ae6..cb53f57ed9 100644
--- a/cpan/Digest-MD5/t/utf8.t
+++ b/cpan/Digest-MD5/t/utf8.t
@@ -7,7 +7,7 @@ BEGIN {
     }
 }
 
-print "1..3\n";
+print "1..5\n";
 
 use strict;
 use Digest::MD5 qw(md5_hex);
@@ -33,3 +33,21 @@ print "ok 2\n";
 # reference
 print "not " unless md5_hex("foo\xFF") eq $exp;
 print "ok 3\n";
+
+# autopromotion
+if ($] >= 5.007003) {
+
+my $unistring = "Oslo.pm har sosialt medlemsmøte onsdag 1. April 2008, klokken 18:30. Vi treffes på Marhaba Café, Keysersgate 1.";
+
+require Encode;
+$unistring = Encode::decode_utf8($unistring);
+print "not " if ( not utf8::is_utf8($unistring));
+print "ok 4\n";
+
+md5_hex($unistring, "");
+print "not " if ( not utf8::is_utf8($unistring));
+print "ok 5\n"
+
+} else {
+    print "ok 4 # SKIP Your perl is too old to properly test unicode semantics\nok 5 # SKIP No, really\n";
+}