Upgrade Digest::MD5 from version 2.40 to 2.50
authorFlorian Ragwitz <rafl@debian.org>
Sat, 25 Sep 2010 22:34:14 +0000 (00:34 +0200)
committerFlorian Ragwitz <rafl@debian.org>
Sat, 25 Sep 2010 23:05:32 +0000 (01:05 +0200)
MANIFEST
Porting/Maintainers.pl
cpan/Digest-MD5/Changes
cpan/Digest-MD5/MD5.pm
cpan/Digest-MD5/MD5.xs
cpan/Digest-MD5/Makefile.PL
cpan/Digest-MD5/README
cpan/Digest-MD5/t/files.t
cpan/Digest-MD5/t/threads.t [new file with mode: 0644]
cpan/Digest-MD5/t/utf8.t
pod/perldelta.pod

index c16eaf5..d1be5fe 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -608,6 +608,7 @@ cpan/Digest-MD5/t/bits.t            See if Digest::MD5 extension works
 cpan/Digest-MD5/t/clone.t              See if Digest::MD5 extension works
 cpan/Digest-MD5/t/files.t              See if Digest::MD5 extension works
 cpan/Digest-MD5/t/md5-aaa.t            See if Digest::MD5 extension works
+cpan/Digest-MD5/t/threads.t            See if Digest::MD5 extension works
 cpan/Digest-MD5/t/utf8.t               See if Digest::MD5 extension works
 cpan/Digest-MD5/typemap                        Digest::MD5 extension
 cpan/Digest-SHA/Changes                        Digest::SHA changes
index de6d64b..f50c19f 100755 (executable)
@@ -475,7 +475,7 @@ use File::Glob qw(:case);
     'Digest::MD5' =>
        {
        'MAINTAINER'    => 'gaas',
-       'DISTRIBUTION'  => 'GAAS/Digest-MD5-2.40.tar.gz',
+       'DISTRIBUTION'  => 'GAAS/Digest-MD5-2.50.tar.gz',
        'FILES'         => q[cpan/Digest-MD5],
        'EXCLUDED'      => [ qw{rfc1321.txt} ],
        'UPSTREAM'      => "cpan",
index 756716c..10e98b7 100644 (file)
@@ -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
index ca17ad4..978eefa 100644 (file)
@@ -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;
index 89e39d2..ac36b05 100644 (file)
@@ -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);
index f8fd182..69b2ed0 100644 (file)
@@ -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', },
 );
 
 
index 3c48079..45c3658 100644 (file)
@@ -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.
index 54cf4f4..854e76f 100644 (file)
@@ -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 (file)
index 0000000..968fd0c
--- /dev/null
@@ -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;
index 6cf68b7..cb53f57 100644 (file)
@@ -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";
+}
index f1663c3..8bd549b 100644 (file)
@@ -169,6 +169,12 @@ XXX
 
 =item *
 
+C<Digest::MD5> has been upgraded from version 2.40 to 2.50.
+
+It is now safe to use this module in combination with threads.
+
+=item *
+
 C<File::DosGlob> has been upgraded from version 1.02 to 1.03.
 
 It allows patterns containing literal parentheses (they no longer need to