r39215 - in /branches/upstream/libpragmatic-perl: ./ current/ current/lib/ current/t/
myon at users.alioth.debian.org
myon at users.alioth.debian.org
Fri Jul 3 11:52:07 UTC 2009
Author: myon
Date: Fri Jul 3 11:52:01 2009
New Revision: 39215
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=39215
Log:
[svn-inject] Installing original source of libpragmatic-perl
Added:
branches/upstream/libpragmatic-perl/
branches/upstream/libpragmatic-perl/current/
branches/upstream/libpragmatic-perl/current/ChangeLog
branches/upstream/libpragmatic-perl/current/MANIFEST
branches/upstream/libpragmatic-perl/current/META.yml
branches/upstream/libpragmatic-perl/current/Makefile.PL
branches/upstream/libpragmatic-perl/current/README
branches/upstream/libpragmatic-perl/current/TODO
branches/upstream/libpragmatic-perl/current/lib/
branches/upstream/libpragmatic-perl/current/lib/Pragmatic.pm (with props)
branches/upstream/libpragmatic-perl/current/t/
branches/upstream/libpragmatic-perl/current/t/01load.t
branches/upstream/libpragmatic-perl/current/t/02simple.t
branches/upstream/libpragmatic-perl/current/t/03args.t
branches/upstream/libpragmatic-perl/current/t/04complex.t
branches/upstream/libpragmatic-perl/current/t/05isa.t
branches/upstream/libpragmatic-perl/current/t/06export.t
Added: branches/upstream/libpragmatic-perl/current/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpragmatic-perl/current/ChangeLog?rev=39215&op=file
==============================================================================
(empty)
Added: branches/upstream/libpragmatic-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpragmatic-perl/current/MANIFEST?rev=39215&op=file
==============================================================================
--- branches/upstream/libpragmatic-perl/current/MANIFEST (added)
+++ branches/upstream/libpragmatic-perl/current/MANIFEST Fri Jul 3 11:52:01 2009
@@ -1,0 +1,13 @@
+lib/Pragmatic.pm
+t/01load.t
+t/02simple.t
+t/03args.t
+t/04complex.t
+t/05isa.t
+t/06export.t
+ChangeLog
+MANIFEST
+Makefile.PL
+README
+TODO
+META.yml Module meta-data (added by MakeMaker)
Added: branches/upstream/libpragmatic-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpragmatic-perl/current/META.yml?rev=39215&op=file
==============================================================================
--- branches/upstream/libpragmatic-perl/current/META.yml (added)
+++ branches/upstream/libpragmatic-perl/current/META.yml Fri Jul 3 11:52:01 2009
@@ -1,0 +1,10 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: Pragmatic
+version: 1.7
+version_from: lib/Pragmatic.pm
+installdirs: site
+requires:
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
Added: branches/upstream/libpragmatic-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpragmatic-perl/current/Makefile.PL?rev=39215&op=file
==============================================================================
--- branches/upstream/libpragmatic-perl/current/Makefile.PL (added)
+++ branches/upstream/libpragmatic-perl/current/Makefile.PL Fri Jul 3 11:52:01 2009
@@ -1,0 +1,22 @@
+require 5.005;
+use strict;
+
+use ExtUtils::MakeMaker;
+
+WriteMakefile
+ (AUTHOR => 'B. K. Oxley (binkley) <binkley at alumni.rice.edu>',
+ ABSTRACT => 'Exporter with pragma support',
+ NAME => 'Pragmatic',
+ VERSION_FROM => 'lib/Pragmatic.pm');
+
+package MY;
+
+# Auto-generate the README from lib/Pramatic.pm:
+sub postamble {
+ q|
+README: $(VERSION_FROM)
+ perldoc -t $< > $@
+
+all:: README
+|;
+}
Added: branches/upstream/libpragmatic-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpragmatic-perl/current/README?rev=39215&op=file
==============================================================================
--- branches/upstream/libpragmatic-perl/current/README (added)
+++ branches/upstream/libpragmatic-perl/current/README Fri Jul 3 11:52:01 2009
@@ -1,0 +1,176 @@
+NAME
+ Pragmatic - Adds pragmata to Exporter
+
+SYNOPSIS
+ In module MyModule.pm:
+
+ package MyModule;
+ require Pragmatic;
+ @ISA = qw (Pragmatic);
+
+ %PRAGMATA = (mypragma => sub {...});
+
+ In other files which wish to use MyModule:
+
+ use MyModule qw (-mypragma); # Execute pragma at import time
+ use MyModule qw (-mypragma=1,2,3); # Pass pragma argument list
+
+DESCRIPTION
+ Pragmatic implements a default "import" method for processing pragmata
+ before passing the rest of the import to Exporter.
+
+ Perl automatically calls the "import" method when processing a "use"
+ statement for a module. Modules and "use" are documented in perlfunc and
+ perlmod.
+
+ (Do not confuse Pragmatic with *pragmatic modules*, such as *less*,
+ *strict* and the like. They are standalone pragmata, and are not
+ associated with any other module.)
+
+ Using Pragmatic Modules
+ Using Pragmatic modules is very simple. To invoke any particular pragma
+ for a given module, include it in the argument list to "use" preceded by
+ a hyphen:
+
+ use MyModule qw (-mypragma);
+
+ "Pragmatic::import" will filter out these arguments, and pass the
+ remainder of the argument list from the "use" statement to
+ "Exporter::import" (actually, to "Exporter::export_to_level" so that
+ Pragmatic is transparent).
+
+ If you want to pass the pragma arguments, use syntax similar to that of
+ the *-M* switch to perl (see perlrun):
+
+ use MyModule qw (-mypragma=abc,1,2,3);
+
+ If there are any warnings or fatal errors, they will appear to come from
+ the "use" statement, not from "Pragmatic::import".
+
+ Writing Pragmatic Modules
+ Writing Pragmatic modules with Pragmatic is straight-forward. First,
+ "require Pragmatic" (you could "use" it instead, but it exports nothing,
+ so there is little to gain thereby). Declare a package global %PRAGMATA,
+ the keys of which are the names of the pragmata and their corresponding
+ values the code references to invoke. Like this:
+
+ package MyPackage;
+
+ require Pragmatic;
+
+ use strict;
+ use vars qw (%PRAGMATA);
+
+ sub something_else { 1; }
+
+ %PRAGMATA =
+ (first => sub { print "@_: first\n"; },
+ second => sub { $SOME_GLOBAL = 1; },
+ third => \&something_else,
+ fourth => 'name_of_sub');
+
+ When a pragma is given in a "use" statement, the leading hyphen is
+ removed, and the code reference corresponding to that key in %PRAGMATA,
+ or a subroutine with the value's name, is invoked with the name of the
+ package as the first member of the argument list (this is the same as
+ what happens with "import"). Additionally, any arguments given by the
+ caller are included (see "Using Pragmatic Modules", above).
+
+EXAMPLES
+ Using Pragmatic Modules
+ 1. Simple use:
+ use MyModule; # no pragmas
+
+ use MyModule qw (-abc); # invoke C<abc>
+
+ use MyModule qw (-p1 -p2); # invoke C<p1>, then C<p2>
+
+ 2. Using an argument list:
+ use MyModule qw (-abc=1,2,3); # invoke C<abc> with (1, 2, 3)
+
+ use MyModule qw (-p1 -p2=here); # invoke C<p1>, then C<p2>
+ # with (1, 2, 3)
+
+ 3. Mixing with arguments for Exporter:
+ (Please see Exporter for a further explanatation.)
+
+ use MyModule ( ); # no pragmas, no exports
+
+ use MyModule qw (fun1 -abc fun2); # import C<fun1>, invoke C<abc>,
+ # then import C<fun2>
+
+ use MyModule qw (:set1 -abc=3); # import set C<set1>, invoke C<abc>
+ # with (3)
+
+ Writing Pragmatic Modules
+ 1. Setting a package global:
+ %PRAGMATA = (debug => sub { $DEBUG = 1; });
+
+ 2. Selecting a method:
+ my $fred = sub { 'fred'; };
+ my $barney = sub { 'barney'; };
+
+ %PRAGMATA =
+ (fred => sub {
+ local $^W = 0;
+ *flintstone = $fred;
+ },
+
+ barney => sub {
+ local $^W = 0;
+ *flintstone = $barney;
+ });
+
+ 3. Changing inheritance:
+ %PRAGMATA = (super => sub { shift; push @ISA, @_; });
+
+ 4. Inheriting pragmata:
+ package X;
+ @ISA = qw(Pragmatic);
+ %PRAGMATA = (debug => 'debug');
+ $DEBUG = 0;
+
+ sub debug { ${"$_[0]::DEBUG"} = 1; }
+
+ package Y:
+ @ISA = qw(X);
+ %PRAGMATA = (debug => 'debug');
+ $DEBUG = 0;
+
+SEE ALSO
+ Exporter
+
+ Exporter does all the heavy-lifting (and is a very interesting module to
+ study) after Pragmatic has stripped out the pragmata from the "use".
+
+DIAGNOSTICS
+ The following are the diagnostics generated by Pragmatic. Items marked
+ "(W)" are non-fatal (invoke "Carp::carp"); those marked "(F)" are fatal
+ (invoke "Carp::croak").
+
+ No such pragma '%s'
+ (F) The caller tried something like "use MyModule (-xxx)" where
+ there was no pragma *xxx* defined for MyModule.
+
+ Invalid pragma '%s'
+ (F) The writer of the called package tried something like "%PRAGMATA
+ = (xxx => not_a_sub)" and either assigned *xxx* a non-code
+ reference, or *xxx* is not a method in that package.
+
+ Pragma '%s' failed
+ (W) The pramga returned a false value. The module is possibly in an
+ inconsisten state after this. Proceed with caution.
+
+AUTHORS
+ B. K. Oxley (binkley) <binkley at alumni.rice.edu>
+
+COPYRIGHT
+ Copyright 1999-2005, B. K. Oxley.
+
+ This library is free software; you may redistribute it and/or modify it
+ under the same terms as Perl itself.
+
+THANKS
+ Thanks to Kevin Caswick <KCaswick at wspackaging.com> for a great patch to
+ run under Perl 5.8.
+
Added: branches/upstream/libpragmatic-perl/current/TODO
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpragmatic-perl/current/TODO?rev=39215&op=file
==============================================================================
(empty)
Added: branches/upstream/libpragmatic-perl/current/lib/Pragmatic.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpragmatic-perl/current/lib/Pragmatic.pm?rev=39215&op=file
==============================================================================
--- branches/upstream/libpragmatic-perl/current/lib/Pragmatic.pm (added)
+++ branches/upstream/libpragmatic-perl/current/lib/Pragmatic.pm Fri Jul 3 11:52:01 2009
@@ -1,0 +1,287 @@
+package Pragmatic;
+
+require 5.001; # ??
+require Exporter;
+
+use strict;
+use vars qw (@ISA $VERSION);
+
+ at ISA = qw (Exporter);
+
+# The package version, both in 1.23 style *and* usable by MakeMaker:
+$VERSION = '1.7';
+my $rcs = '$Id: Pragmatic.pm 164 2005-03-15 21:42:20Z binkley $' ;
+
+
+sub import ($) {
+ my $package = shift;
+
+ return $package->export_to_level (1, $package, @_)
+ if $package eq __PACKAGE__;
+
+ my $warn = sub (;$) {
+ require Carp;
+ local $Carp::CarpLevel = 2; # relocate to calling package
+ Carp::carp (@_);
+ };
+
+ my $die = sub (;$) {
+ require Carp;
+ local $Carp::CarpLevel = 2; # relocate to calling package
+ Carp::croak (@_);
+ };
+
+ my @imports = grep /^[^-]/, @_;
+ my @pragmata = map { substr($_, 1); } grep /^-/, @_;
+
+ # Export first, for side-effects (e.g., importing globals, then
+ # setting them with pragmata):
+ $package->export_to_level (1, $package, @imports)
+ if @imports;
+
+ for (@pragmata) {
+ no strict qw (refs);
+
+ my ($pragma, $args) = split /=/, $_;
+ my (@args) = split /,/, $args || '';
+
+ exists ${"$package\::PRAGMATA"}{$pragma}
+ or &$die ("No such pragma '$pragma'");
+
+ if (ref ${"$package\::PRAGMATA"}{$pragma} eq 'CODE') {
+ &{${"$package\::PRAGMATA"}{$pragma}} ($package, @args)
+ or &$warn ("Pragma '$pragma' failed");
+
+ # Let inheritance work for barewords:
+ } elsif (my $ref = $package->can
+ (${"$package\::PRAGMATA"}{$pragma})) {
+ &$ref ($package, @args)
+ or &$warn ("Pragma '$pragma' failed");
+
+ } else {
+ &$die ("Invalid pragma '$pragma'");
+ }
+ }
+}
+
+1;
+
+
+__END__
+
+
+=head1 NAME
+
+Pragmatic - Adds pragmata to Exporter
+
+=head1 SYNOPSIS
+
+In module MyModule.pm:
+
+ package MyModule;
+ require Pragmatic;
+ @ISA = qw (Pragmatic);
+
+ %PRAGMATA = (mypragma => sub {...});
+
+In other files which wish to use MyModule:
+
+ use MyModule qw (-mypragma); # Execute pragma at import time
+ use MyModule qw (-mypragma=1,2,3); # Pass pragma argument list
+
+=head1 DESCRIPTION
+
+B<Pragmatic> implements a default C<import> method for processing
+pragmata before passing the rest of the import to B<Exporter>.
+
+Perl automatically calls the C<import> method when processing a
+C<use> statement for a module. Modules and C<use> are documented
+in L<perlfunc> and L<perlmod>.
+
+(Do not confuse B<Pragmatic> with I<pragmatic modules>, such as
+I<less>, I<strict> and the like. They are standalone pragmata, and
+are not associated with any other module.)
+
+=head2 Using Pragmatic Modules
+
+Using Pragmatic modules is very simple. To invoke any
+particular pragma for a given module, include it in the argument list
+to C<use> preceded by a hyphen:
+
+ use MyModule qw (-mypragma);
+
+C<Pragmatic::import> will filter out these arguments, and pass the
+remainder of the argument list from the C<use> statement to
+C<Exporter::import> (actually, to C<Exporter::export_to_level> so that
+B<Pragmatic> is transparent).
+
+If you want to pass the pragma arguments, use syntax similar to that
+of the I<-M> switch to B<perl> (see L<perlrun>):
+
+ use MyModule qw (-mypragma=abc,1,2,3);
+
+If there are any warnings or fatal errors, they will appear to come
+from the C<use> statement, not from C<Pragmatic::import>.
+
+=head2 Writing Pragmatic Modules
+
+Writing Pragmatic modules with B<Pragmatic> is straight-forward.
+First, C<require Pragmatic> (you could C<use> it instead, but it
+exports nothing, so there is little to gain thereby). Declare a
+package global C<%PRAGMATA>, the keys of which are the names of the
+pragmata and their corresponding values the code references to invoke.
+Like this:
+
+ package MyPackage;
+
+ require Pragmatic;
+
+ use strict;
+ use vars qw (%PRAGMATA);
+
+ sub something_else { 1; }
+
+ %PRAGMATA =
+ (first => sub { print "@_: first\n"; },
+ second => sub { $SOME_GLOBAL = 1; },
+ third => \&something_else,
+ fourth => 'name_of_sub');
+
+When a pragma is given in a C<use> statement, the leading hyphen is
+removed, and the code reference corresponding to that key in
+C<%PRAGMATA>, or a subroutine with the value's name, is invoked with
+the name of the package as the first member of the argument list (this
+is the same as what happens with C<import>). Additionally, any
+arguments given by the caller are included (see L<Using Pragmatic
+Modules>, above).
+
+=head1 EXAMPLES
+
+=head2 Using Pragmatic Modules
+
+=over
+
+=item 1. Simple use:
+
+ use MyModule; # no pragmas
+
+ use MyModule qw (-abc); # invoke C<abc>
+
+ use MyModule qw (-p1 -p2); # invoke C<p1>, then C<p2>
+
+=item 2. Using an argument list:
+
+ use MyModule qw (-abc=1,2,3); # invoke C<abc> with (1, 2, 3)
+
+ use MyModule qw (-p1 -p2=here); # invoke C<p1>, then C<p2>
+ # with (1, 2, 3)
+
+=item 3. Mixing with arguments for B<Exporter>:
+
+(Please see L<Exporter> for a further explanatation.)
+
+ use MyModule ( ); # no pragmas, no exports
+
+ use MyModule qw (fun1 -abc fun2); # import C<fun1>, invoke C<abc>,
+ # then import C<fun2>
+
+ use MyModule qw (:set1 -abc=3); # import set C<set1>, invoke C<abc>
+ # with (3)
+
+=back
+
+=head2 Writing Pragmatic Modules
+
+=over
+
+=item 1. Setting a package global:
+
+ %PRAGMATA = (debug => sub { $DEBUG = 1; });
+
+=item 2. Selecting a method:
+
+ my $fred = sub { 'fred'; };
+ my $barney = sub { 'barney'; };
+
+ %PRAGMATA =
+ (fred => sub {
+ local $^W = 0;
+ *flintstone = $fred;
+ },
+
+ barney => sub {
+ local $^W = 0;
+ *flintstone = $barney;
+ });
+
+=item 3. Changing inheritance:
+
+ %PRAGMATA = (super => sub { shift; push @ISA, @_; });
+
+=item 4. Inheriting pragmata:
+
+ package X;
+ @ISA = qw(Pragmatic);
+ %PRAGMATA = (debug => 'debug');
+ $DEBUG = 0;
+
+ sub debug { ${"$_[0]::DEBUG"} = 1; }
+
+ package Y:
+ @ISA = qw(X);
+ %PRAGMATA = (debug => 'debug');
+ $DEBUG = 0;
+
+=back
+
+=head1 SEE ALSO
+
+L<Exporter>
+
+B<Exporter> does all the heavy-lifting (and is a very interesting
+module to study) after B<Pragmatic> has stripped out the pragmata from
+the C<use>.
+
+=head1 DIAGNOSTICS
+
+The following are the diagnostics generated by B<Pragmatic>. Items
+marked "(W)" are non-fatal (invoke C<Carp::carp>); those marked "(F)"
+are fatal (invoke C<Carp::croak>).
+
+=over
+
+=item No such pragma '%s'
+
+(F) The caller tried something like "use MyModule (-xxx)" where there
+was no pragma I<xxx> defined for MyModule.
+
+=item Invalid pragma '%s'
+
+(F) The writer of the called package tried something like "%PRAGMATA =
+(xxx => not_a_sub)" and either assigned I<xxx> a non-code reference,
+or I<xxx> is not a method in that package.
+
+=item Pragma '%s' failed
+
+(W) The pramga returned a false value. The module is possibly in an
+inconsisten state after this. Proceed with caution.
+
+=back
+
+=head1 AUTHORS
+
+B. K. Oxley (binkley) E<lt>binkley at alumni.rice.eduE<gt>
+
+=head1 COPYRIGHT
+
+ Copyright 1999-2005, B. K. Oxley.
+
+This library is free software; you may redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 THANKS
+
+Thanks to Kevin Caswick E<lt>KCaswick at wspackaging.comE<gt> for a great
+patch to run under Perl 5.8.
+
+=cut
Propchange: branches/upstream/libpragmatic-perl/current/lib/Pragmatic.pm
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libpragmatic-perl/current/t/01load.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpragmatic-perl/current/t/01load.t?rev=39215&op=file
==============================================================================
--- branches/upstream/libpragmatic-perl/current/t/01load.t (added)
+++ branches/upstream/libpragmatic-perl/current/t/01load.t Fri Jul 3 11:52:01 2009
@@ -1,0 +1,10 @@
+# Emacs, this is -*-perl-*- code.
+
+BEGIN { use Test; plan tests => 1; }
+
+use strict;
+
+use Test;
+
+eval "use Pragmatic;";
+ok (not $@);
Added: branches/upstream/libpragmatic-perl/current/t/02simple.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpragmatic-perl/current/t/02simple.t?rev=39215&op=file
==============================================================================
--- branches/upstream/libpragmatic-perl/current/t/02simple.t (added)
+++ branches/upstream/libpragmatic-perl/current/t/02simple.t Fri Jul 3 11:52:01 2009
@@ -1,0 +1,50 @@
+# Emacs, this is -*- perl -*- code.
+
+BEGIN { use Test; plan tests => 4; }
+
+use Test;
+
+# Test 1:
+eval join '', <DATA>;
+ok (not $@);
+
+# Test 2:
+eval { import X qw (-abc); };
+ok (not $@);
+
+# Test 3, 4:
+eval { import Y qw (-def); };
+ok (not $@);
+ok ($Y::DEBUG, 1);
+
+# Get rid of "used only once" warning:
+do { 1; } if $Y::DEBUG;
+
+__DATA__
+
+package X;
+
+use strict;
+use vars qw(@ISA %PRAGMATA);
+
+require Pragmatic;
+
+ at ISA = qw(Pragmatic);
+
+%PRAGMATA = (abc => sub { 1; });
+
+1;
+
+
+package Y;
+
+use strict;
+use vars qw ($DEBUG @ISA %PRAGMATA);
+
+$DEBUG = 0;
+
+ at ISA = qw(X);
+
+%PRAGMATA = (def => sub { $DEBUG = 1; });
+
+1;
Added: branches/upstream/libpragmatic-perl/current/t/03args.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpragmatic-perl/current/t/03args.t?rev=39215&op=file
==============================================================================
--- branches/upstream/libpragmatic-perl/current/t/03args.t (added)
+++ branches/upstream/libpragmatic-perl/current/t/03args.t Fri Jul 3 11:52:01 2009
@@ -1,0 +1,38 @@
+# Emacs, this is -*- perl -*- code.
+
+BEGIN { use Test; plan tests => 5; }
+
+use strict;
+
+use Test;
+
+# Test 1:
+eval join '', <DATA>;
+ok (not $@);
+
+# Test 2, 3:
+eval { import X qw (-abc); };
+ok (not $@);
+ok ($X::DEBUG, 0);
+
+# Test 4, 5:
+eval { import X qw (-abc=fox); };
+ok (not $@);
+ok ($X::DEBUG, 'fox');
+
+__DATA__
+
+package X;
+
+use strict;
+use vars qw($DEBUG @ISA %PRAGMATA);
+
+require Pragmatic;
+
+$DEBUG = 0;
+
+ at ISA = qw(Pragmatic);
+
+%PRAGMATA = (abc => sub { $DEBUG = $_[1] || 0; 1; });
+
+1;
Added: branches/upstream/libpragmatic-perl/current/t/04complex.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpragmatic-perl/current/t/04complex.t?rev=39215&op=file
==============================================================================
--- branches/upstream/libpragmatic-perl/current/t/04complex.t (added)
+++ branches/upstream/libpragmatic-perl/current/t/04complex.t Fri Jul 3 11:52:01 2009
@@ -1,0 +1,75 @@
+# Emacs, this is -*- perl -*- code.
+
+BEGIN { use Test; plan tests => 11; }
+
+use Test;
+
+# Test 1:
+eval join '', <DATA>;
+ok (not $@);
+
+# Test 2, 3:
+eval { import X; };
+ok (not $@);
+eval { X->flintstone; }; # die
+ok ($@);
+
+# Test 4, 5:
+eval { import X qw (-fred); };
+ok (not $@);
+ok (X->flintstone, 'fred');
+
+# Test 6, 7:
+eval { import X qw (-barney); };
+ok (not $@);
+ok (X->flintstone, 'barney');
+
+# Test 8, 9:
+eval { import X qw (-flintstone=wilma); };
+ok (not $@);
+ok (X->flintstone, 'wilma');
+
+# Test 10, 11:
+eval { import X qw (-flintstone=betty); };
+ok (not $@);
+eval { X->flintstone; }; # die
+ok ($@);
+
+__DATA__
+
+package X;
+
+use strict;
+use vars qw($DEBUG @ISA %PRAGMATA);
+
+require Pragmatic;
+
+$DEBUG = 0;
+
+ at ISA = qw(Pragmatic);
+
+my $fred = sub { 'fred'; };
+my $barney = sub { 'barney'; };
+
+sub wilma { 'wilma'; }
+# no sub betty
+
+# Need to suppress 'Subroutine %s redefined' warnings:
+%PRAGMATA =
+ (fred => sub {
+ local $^W = 0;
+ *flintstone = $fred;
+ },
+
+ barney => sub {
+ local $^W = 0;
+ *flintstone = $barney;
+ },
+
+ flintstone => sub {
+ no strict qw(refs);
+ local $^W = 0;
+ *flintstone = *{$_[1]};
+ });
+
+1;
Added: branches/upstream/libpragmatic-perl/current/t/05isa.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpragmatic-perl/current/t/05isa.t?rev=39215&op=file
==============================================================================
--- branches/upstream/libpragmatic-perl/current/t/05isa.t (added)
+++ branches/upstream/libpragmatic-perl/current/t/05isa.t Fri Jul 3 11:52:01 2009
@@ -1,0 +1,48 @@
+# Emacs, this is -*- perl -*- code.
+
+BEGIN { use Test; plan tests => 5; }
+
+use strict;
+
+use Test;
+
+# Test 1:
+eval join '', <DATA>;
+ok (not $@);
+
+# Test 2, 3:
+eval { import X; };
+ok (not $@);
+ok (X->physics, 'fun');
+
+# Test 4, 5:
+eval { import X qw(-notso); };
+ok (not $@);
+ok (X->physics, 'nofun');
+
+__DATA__
+
+package Truth;
+
+sub physics { 'fun'; }
+
+
+package Untruth;
+
+sub physics { 'nofun'; }
+
+
+package X;
+
+use strict;
+use vars qw(@ISA %PRAGMATA);
+
+require Pragmatic;
+
+ at ISA = qw(Pragmatic Truth);
+
+%PRAGMATA =
+ (notso => sub {
+ @ISA = map { $_ eq 'Truth' and $_ = 'Untruth' } @ISA; });
+
+1;
Added: branches/upstream/libpragmatic-perl/current/t/06export.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpragmatic-perl/current/t/06export.t?rev=39215&op=file
==============================================================================
--- branches/upstream/libpragmatic-perl/current/t/06export.t (added)
+++ branches/upstream/libpragmatic-perl/current/t/06export.t Fri Jul 3 11:52:01 2009
@@ -1,0 +1,39 @@
+# Emacs, this is -*- perl -*- code.
+
+BEGIN { use Test; plan tests => 5; }
+
+use strict;
+no strict qw(refs subs); # permit ${::}{...}
+
+use Test;
+
+# Test 1:
+eval join '', <DATA>;
+ok (not $@);
+
+# Test 2, 3:
+eval { import X; };
+ok (not $@);
+ok (exists ${::}{abc}, '');
+
+# Test 4, 5:
+eval { import X qw(abc); };
+ok (not $@);
+ok (exists ${::}{abc}, 1);
+
+__DATA__
+
+package X;
+
+use strict;
+use vars qw(@EXPORT_OK @ISA %PRAGMATA);
+
+require Pragmatic;
+
+ at EXPORT_OK = qw(abc);
+
+ at ISA = qw(Pragmatic);
+
+sub abc { 1; }
+
+1;
More information about the Pkg-perl-cvs-commits
mailing list