Experimental module intended to simplify core regression tests

p4raw-id: //depot/perl@23707

2 files changed, 96 insertions, 0 deletions

diff --git a/lib/Config/Extensions.pm b/lib/Config/Extensions.pm
new file mode 100644
index 0000000000..82fb9e09e8
--- /dev/null
+++ b/lib/Config/Extensions.pm
@@ -0,0 +1,63 @@
+package Config::Extensions;
+use strict;
+use vars qw(%Extensions $VERSION @ISA @EXPORT_OK);
+use Config;
+require Exporter;
+
+$VERSION = '0.01';
+@ISA = 'Exporter';
+@EXPORT_OK = '%Extensions';
+
+foreach my $type (qw(static dynamic nonxs)) {
+    foreach (split /\s+/, $Config{$type . '_ext'}) {
+	s!/!::!g;
+	$Extensions{$_} = $type;
+    }
+}
+
+1;
+__END__
+=head1 NAME
+
+Config::Extensions - hash lookup of which core extensions were built.
+
+=head1 SYNOPSIS
+
+    use Config::Extensions '%Extensions';
+    if ($Extensions{PerlIO::via}) {
+        # This perl has PerlIO::via built
+    }
+
+=head1 DESCRIPTION
+
+The Config::Extensions module provides a hash C<%Extensions> containing all
+the core extensions that were enabled for this perl. The hash is keyed by
+extension name, with each entry having one of 3 possible values:
+
+=over 4
+
+=item dynamic
+
+The extension is dynamically linked
+
+=item nonxs
+
+The extension is pure perl, so doesn't need linking to the perl executable
+
+=item static
+
+The extension is statically linked to the perl binary
+
+=back
+
+As all values evaluate to true, a simple C<if> test is good enough to determine
+whether an extension is present.
+
+All the data uses to generate the C<%Extensions> hash is already present in
+the C<Config> module, but not in such a convenient format to quickly reference.
+
+=head1 AUTHOR
+
+Nicholas Clark <nick@ccl4.org>
+
+=cut
diff --git a/lib/Config/Extensions.t b/lib/Config/Extensions.t
new file mode 100644
index 0000000000..1d730b0dd5
--- /dev/null
+++ b/lib/Config/Extensions.t
@@ -0,0 +1,33 @@
+#!perl -w
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't' if -d 't';
+        @INC = '../lib';
+    }
+}
+use strict;
+use Test::More 'no_plan';
+
+BEGIN {use_ok 'Config::Extensions', '%Extensions'};
+
+use Config;
+
+my @types = qw(dynamic static nonxs);
+my %types;
+@types{@types} = @types;
+
+ok (keys %Extensions, "There are some extensions");
+# Check only the 3 valid keys have been used.
+while (my ($key, $val) = each %Extensions) {
+    my $raw_ext = $key;
+    # Back to the format in Config
+    $raw_ext =~ s!::!/!g;
+    my $re = qr/\b\Q$raw_ext\E\b/;
+    like($Config{extensions}, $re, "$key was built");
+    unless ($types{$val}) {
+	fail("$key is $val");
+	next;
+    }
+    my $type = $val . '_ext';
+    like($Config{$type}, $re, "$key is $type");
+}