From: Rafael Garcia-Suarez Date: Mon, 8 Dec 2003 15:22:26 +0000 (+0000) Subject: Upgrade to Digest-MD5 2.33. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ee7ea0b1d2b6387b29185648ded39b92e1001529;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Digest-MD5 2.33. p4raw-id: //depot/perl@21871 --- diff --git a/ext/Digest/MD5/Changes b/ext/Digest/MD5/Changes index 97a2c50..1a49ffd 100644 --- a/ext/Digest/MD5/Changes +++ b/ext/Digest/MD5/Changes @@ -1,3 +1,26 @@ +2003-12-07 Gisle Aas + + Release 2.33 + + Enable explicit context passing for slight performance + improvement in threaded perls. + + Tweaks to the Makefile.PL so that it is suitable both for + core and CPAN use. + + + +2003-12-05 Gisle Aas + + Release 2.32 + + Don't run u32align test program on HP-UX 10.20 as it + will hang. Patch by H.Merijn Brand . + + Fixed documentation typo. + + + 2003-11-28 Gisle Aas Release 2.31 diff --git a/ext/Digest/MD5/MD5.pm b/ext/Digest/MD5/MD5.pm index 13342b5..8e8bc49 100644 --- a/ext/Digest/MD5/MD5.pm +++ b/ext/Digest/MD5/MD5.pm @@ -3,7 +3,7 @@ package Digest::MD5; use strict; use vars qw($VERSION @ISA @EXPORT_OK); -$VERSION = '2.31'; # $Date: 2003/11/28 13:06:19 $ +$VERSION = '2.33'; # $Date: 2003/12/07 08:40:18 $ require Exporter; *import = \&Exporter::import; @@ -190,8 +190,8 @@ C before you pass it as argument to the addfile() method. Since the MD5 algorithm is byte oriented you might only add bits as multiples of 8, so you probably want to just use add() instead. The add_bits() method is provided for compatibility with other digest -implementations. See L for description arguments to -add_bits(). +implementations. See L for description of the arguments +that add_bits() take. =item $md5->digest diff --git a/ext/Digest/MD5/MD5.xs b/ext/Digest/MD5/MD5.xs index 287550c..1abe4c4 100644 --- a/ext/Digest/MD5/MD5.xs +++ b/ext/Digest/MD5/MD5.xs @@ -1,4 +1,4 @@ -/* $Id: MD5.xs,v 1.40 2003/07/22 05:59:27 gisle Exp $ */ +/* $Id: MD5.xs,v 1.42 2003/12/06 22:35:16 gisle Exp $ */ /* * This library is free software; you can redistribute it and/or @@ -37,6 +37,7 @@ #ifdef __cplusplus extern "C" { #endif +#define PERL_NO_GET_CONTEXT /* we want efficiency */ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" @@ -83,6 +84,11 @@ extern "C" { #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 @@ -460,7 +466,7 @@ MD5Final(U8* digest, MD5_CTX *ctx) #define INT2PTR(any,d) (any)(d) #endif -static MD5_CTX* get_md5_ctx(SV* sv) +static MD5_CTX* get_md5_ctx(pTHX_ SV* sv) { if (SvROK(sv)) { sv = SvRV(sv); @@ -521,7 +527,7 @@ static char* base64_16(const unsigned char* from, char* to) #define F_HEX 1 #define F_B64 2 -static SV* make_mortal_sv(const unsigned char *src, int type) +static SV* make_mortal_sv(pTHX_ const unsigned char *src, int type) { STRLEN len; char result[33]; @@ -571,7 +577,7 @@ new(xclass) sv_setref_pv(ST(0), sclass, (void*)context); SvREADONLY_on(SvRV(ST(0))); } else { - context = get_md5_ctx(xclass); + context = get_md5_ctx(aTHX_ xclass); } MD5Init(context); XSRETURN(1); @@ -580,7 +586,7 @@ void clone(self) SV* self PREINIT: - MD5_CTX* cont = get_md5_ctx(self); + MD5_CTX* cont = get_md5_ctx(aTHX_ self); char *myname = sv_reftype(SvRV(self),TRUE); MD5_CTX* context; PPCODE: @@ -602,7 +608,7 @@ void add(self, ...) SV* self PREINIT: - MD5_CTX* context = get_md5_ctx(self); + MD5_CTX* context = get_md5_ctx(aTHX_ self); int i; unsigned char *data; STRLEN len; @@ -618,7 +624,7 @@ addfile(self, fh) SV* self InputStream fh PREINIT: - MD5_CTX* context = get_md5_ctx(self); + MD5_CTX* context = get_md5_ctx(aTHX_ self); STRLEN fill = context->bytes_low & 0x3F; unsigned char buffer[4096]; int n; @@ -662,7 +668,7 @@ digest(context) PPCODE: MD5Final(digeststr, context); MD5Init(context); /* In case it is reused */ - ST(0) = make_mortal_sv(digeststr, ix); + ST(0) = make_mortal_sv(aTHX_ digeststr, ix); XSRETURN(1); void @@ -709,5 +715,5 @@ md5(...) MD5Update(&ctx, data, len); } MD5Final(digeststr, &ctx); - ST(0) = make_mortal_sv(digeststr, ix); + ST(0) = make_mortal_sv(aTHX_ digeststr, ix); XSRETURN(1); diff --git a/ext/Digest/MD5/Makefile.PL b/ext/Digest/MD5/Makefile.PL index b2c974e..3448572 100644 --- a/ext/Digest/MD5/Makefile.PL +++ b/ext/Digest/MD5/Makefile.PL @@ -1,8 +1,12 @@ -require 5.004; +#!perl -w + +BEGIN { require 5.004 } use strict; use Config qw(%Config); use ExtUtils::MakeMaker; +my $PERL_CORE = grep $_ eq "PERL_CORE=1", @ARGV; + my @extra; @extra = (DEFINE => "-DU32_ALIGNMENT_REQUIRED") unless free_u32_alignment(); @@ -16,11 +20,14 @@ if ($^O eq 'VMS') { } push(@extra, 'INSTALLDIRS' => 'perl') if $] >= 5.008; +push(@extra, 'MAN3PODS' => {}) if $PERL_CORE; # Pods built by installman. WriteMakefile( 'NAME' => 'Digest::MD5', 'VERSION_FROM' => 'MD5.pm', - MAN3PODS => {}, # Pods will be built by installman. + 'PREREQ_PM' => { 'File::Spec' => 0, + 'Digest::base' => '1.00', + }, @extra, 'dist' => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, ); @@ -29,7 +36,115 @@ WriteMakefile( sub free_u32_alignment { - return 0 if $Config{d_u32align}; - return 1 if $Config{'byteorder'} eq '1234' || $Config{'byteorder'} eq '4321'; + $|=1; + if (exists $Config{d_u32align}) { + print "Perl's config says that U32 access must "; + print "not " unless $Config{d_u32align}; + print "be aligned.\n"; + return !$Config{d_u32align}; + } + + if ($^O eq 'VMS' || $^O eq 'MSWin32') { + print "Assumes that $^O implies free alignment for U32 access.\n"; + return 1; + } + + if ($^O eq 'hpux' && $Config{osvers} < 11.0) { + print "Will not test for free alignment on older HP-UX.\n"; + return 0; + } + + print "Testing alignment requirements for U32... "; + open(ALIGN_TEST, ">u32align.c") or die "$!"; + print ALIGN_TEST <<'EOT'; close(ALIGN_TEST); +/*--------------------------------------------------------------*/ +/* This program allocates a buffer of U8 (char) and then tries */ +/* to access it through a U32 pointer at every offset. The */ +/* program is expected to die with a bus error/seg fault for */ +/* machines that do not support unaligned integer read/write */ +/*--------------------------------------------------------------*/ + +#include +#include "EXTERN.h" +#include "perl.h" + +#ifdef printf + #undef printf +#endif + +int main(int argc, char** argv, char** env) +{ +#if BYTEORDER == 0x1234 || BYTEORDER == 0x4321 + U8 buf[] = "\0\0\0\1\0\0\0\0"; + U32 *up; + int i; + + if (sizeof(U32) != 4) { + printf("sizeof(U32) is not 4, but %d\n", sizeof(U32)); + exit(1); + } + + fflush(stdout); + + for (i = 0; i < 4; i++) { + up = (U32*)(buf + i); + if (! ((*up == 1 << (8*i)) || /* big-endian */ + (*up == 1 << (8*(3-i))) /* little-endian */ + ) + ) + { + printf("read failed (%x)\n", *up); + exit(2); + } + } + + /* write test */ + for (i = 0; i < 4; i++) { + up = (U32*)(buf + i); + *up = 0xBeef; + if (*up != 0xBeef) { + printf("write failed (%x)\n", *up); + exit(3); + } + } + + printf("no restrictions\n"); + exit(0); +#else + printf("unusual byteorder, playing safe\n"); + exit(1); +#endif + return 0; +} +/*--------------------------------------------------------------*/ +EOT + + my $cc_cmd = "$Config{cc} $Config{ccflags} -I$Config{archlibexp}/CORE"; + my $exe = "u32align$Config{exe_ext}"; + $cc_cmd .= " -o $exe"; + my $rc; + $rc = system("$cc_cmd $Config{ldflags} u32align.c $Config{libs}"); + if ($rc) { + print "Can't compile test program. Will ensure alignment to play safe.\n\n"; + unlink("u32align.c", $exe, "u32align$Config{obj_ext}"); + return 0; + } + + $rc = system("./$exe"); + unlink("u32align.c", $exe, "u32align$Config{obj_ext}"); + + return 1 unless $rc; + + if ($rc > 0x80) { + $rc >>= 8; + print "Test program exit status was $rc\n"; + } else { + if ($rc & 0x80) { + $rc &= ~0x80; + print "Core dump deleted\n"; + unlink("core"); + } + print "signal $rc\n"; + } return 0; } diff --git a/ext/Digest/MD5/t/files.t b/ext/Digest/MD5/t/files.t index fd965ca..3f18320 100644 --- a/ext/Digest/MD5/t/files.t +++ b/ext/Digest/MD5/t/files.t @@ -20,27 +20,27 @@ use Digest::MD5 qw(md5 md5_hex md5_base64); my $EXPECT; if (ord "A" == 193) { # EBCDIC $EXPECT = <