From: Craig A. Berry <craigberry@mac.com>
Date: Sat, 28 Feb 2009 17:47:56 +0000 (-0600)
Subject: Make deprecate.pm work on VMS.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=096fcbb836f6fd56aeb7ca9c34ea5bec57be8b6a;p=p5sagit%2Fp5-mst-13.2.git

Make deprecate.pm work on VMS.
---

diff --git a/lib/deprecate.pm b/lib/deprecate.pm
index e8063b3..9519223 100644
--- a/lib/deprecate.pm
+++ b/lib/deprecate.pm
@@ -15,11 +15,14 @@ sub import {
     foreach my $pair ([qw(sitearchexp archlibexp)],
 		      [qw(sitelibexp privlibexp)]) {
 	my ($site, $priv) = @Config{@$pair};
+	if ($^O eq 'VMS') {
+	    for my $d ($site, $priv) { $d = VMS::Filespec::unixify($d) };
+	}
 	# Just in case anyone managed to configure with trailing /s
 	s!/*$!!g foreach $site, $priv;
 
 	next if $site eq $priv;
-	if ("$priv/$expect_leaf" eq $file) {
+	if (uc("$priv/$expect_leaf") eq uc($file)) {
 	    my $call_depth=1;
 	    my @caller;
 	    while (@caller = caller $call_depth++) {
diff --git a/t/lib/deprecate.t b/t/lib/deprecate.t
index fb11528..274a7b6 100644
--- a/t/lib/deprecate.t
+++ b/t/lib/deprecate.t
@@ -48,7 +48,8 @@ for my $lib (sort keys %tests) {
     }
     if( $tests{$lib} ) {
         like($warn, qr/^Deprecated\s+will\s+be\s+removed\b/, "$lib - message");
-        like($warn, qr/$0,?\s+line\s+1001\.?\n*$/, "$lib - location");
+        my $me = quotemeta($0);
+        like($warn, qr/$me,?\s+line\s+1001\.?\n*$/, "$lib - location");
     }
     else {
 	ok( !$warn, "$lib - no message" );