Bloodnok has asked for the wisdom of the Perl Monks concerning the following question:

Hi learned ones ,

Whilst attempting to develop a test harness, using Test::More, for a bespoke module I'm developing, I noticed the behaviour outlined in the following example code/results - simply put, it is that the second call to import() fails to create the class package.
I'm absolutely convinced I've missed something obvious - I've been looking at the problem for so long, I can no longer see the wood for the trees.
Could anyone enlighten this confused resident please ?

Package code: 

package WTF;

use strict;
use warnings;

use Carp;

sub define {
    my $self = shift;
    my $type = shift || croak "No type name";

    my ($code, $parent, $subclass) =
        ('', __PACKAGE__, __PACKAGE__ . "\::$type");

    # Get the package code template
    {
        local $/ = undef;
        while (<DATA>) {
            s,##PACKAGE##,$subclass,g;
            s,##PARENT##,$parent,g;
            $code .= $_;
        }

        my $WARNING = '';
        local $SIG{__WARN__} = sub { $WARNING = "@_" };
        eval $code;
        croak "Failed to create subclass: $subclass - $WARNING$@" if
            $WARNING || $@;

        croak "Problem with subclass: $subclass - cannot new()" unless
            $subclass->can(qw/new/);
    }

    print STDERR "Created type: $type\n";
}

sub import {
    my $self = shift;

    while (@_) {
        my ($nm, $list) = splice(@_, 0 ,2);

        __PACKAGE__->define($nm => $list);
    }
}

1;

__DATA__

package ##PACKAGE##;

use strict;
use warnings;

use ##PARENT##;
my @ISA = ( qw/##PARENT##/ );

sub new {
    my $self = shift;

    bless \( my $scalar ), ref $self || $self;
}

[download]
Script: 
use strict;
use warnings;

# Emulate use
BEGIN {
    require WTF;
    WTF->import(qw/some/);
    WTF->import(qw/more/);
}

[download]
When WTF.pl is run, the following is seen: 
C:\WINDOWS\system32\cmd.exe /c perl WTF.pl
Created type: some
Problem with subclass: WTF::more - cannot new() at WTF.pl line 8
BEGIN failed--compilation aborted at WTF.pl line 9, <DATA> line 1.
shell returned 255
Hit any key to close this window...

[download]
Update #1 When run on AIX (perl V 5.8.8), the same, or extremely similar, results are... 
!perl WTF.pl
Created type: some
Problem with subclass: WTF::more - cannot new() at WTF.pl line 8
BEGIN failed--compilation aborted at WTF.pl line 9, <DATA> line 1.

[download]
Update #2 Ultimately, what I'm aiming for is to write a test harness that fully tests the usage of the module - I implemented it all in a single .t file, but am beginning to think I can only acheive my aim by having a plethora of, much smaller, .t files...

TIA

At last, a user level that overstates my experience :-))

Replies are listed 'Best First'.
Re: Problem emulating use
by almut (Canon) on Jul 11, 2008 at 12:00 UTC

    I suppose the problem is that you're trying to read from __DATA__ more than once...  Try storing the initial file pointer position using tell, and then seek to that position before your while (<DATA>) {...} loop.  Alternatively, load the template code into a variable that you can then use repeatedly...

[reply]
[d/l]
[select]
      TFT Almut
      You're a hair saver !! :-))
      Just the insight I needed - declaring a package variable, $template, and changing define() to... 
      sub define {
    my $self = shift;
    my $type = shift || croak "No type name";

    unless ($template) {
        local $/ = undef;
        $template = <DATA>;
    }

    my ($code, $parent, $subclass) =
        ($template, __PACKAGE__, __PACKAGE__ . "\::$type");

    $code =~ s,##PACKAGE##,$subclass,g;
    $code =~ s,##PARENT##,$parent,g;

    {
        my $WARNING = '';
        local $SIG{__WARN__} = sub { $WARNING = "@_" };
        eval $code;
        croak "Failed to create subclass: $subclass - $WARNING$@" if
            $WARNING || $@;

        croak "Problem with subclass: $subclass - cannot new()" unless
            $subclass->can(qw/new/);
    }

    print STDERR "Created type: $type\n";
}

      [download]
      ... works fine.
      Thanx again

      At last, a user level that overstates my experience :-))
[reply]
[d/l]
[select]
Re: Problem emulating use
by Arunbear (Prior) on Jul 12, 2008 at 19:46 UTC
    As the subclasses that you're creating don't have any file scoped 'my' variables in them, you could create them with symbolic references instead of eval: 
    package WTF;

use strict;
use warnings;
use Carp;

sub define {
    my $self = shift;
    my $type = shift || croak "No type name";

    my ($parent, $subclass) =
        (__PACKAGE__, __PACKAGE__ . "\::$type");

    my $new = sub {
        my $self = shift;

        bless \( my $scalar ), $subclass;
    };
    {
        no strict 'refs';
        @{"${subclass}::ISA"} = ( $parent );
        *{"${subclass}::new"} = $new;
    }
    warn "Created type: $type\n";
}

sub import {
    my $self = shift;

    while (@_) {
        my ($nm, $list) = splice(@_, 0 ,2);

        __PACKAGE__->define($nm => $list);
    }
}

1;

    [download]
    then a small change to your script to dump out the symbol tables of the subclasses: 
    use strict;
use warnings;
use Data::Dump::Streamer;
use lib '.';

# Emulate use
BEGIN {
    require WTF;
    WTF->import(qw/some/);
    WTF->import(qw/more/);
}
Dump(\(%WTF::some::, %WTF::more::));

    [download]
    gives: 
    Created type: some
Created type: more
my ($subclass,$subclass_eclipse_1);
$subclass = 'WTF::some';
$subclass_eclipse_1 = 'WTF::more';
$HASH1 = {
           ISA => *WTF::some::ISA,
           new => *WTF::some::new
         };
*WTF::some::ISA = [ 'WTF' ];
*WTF::some::new = sub {
                    package WTF;
                    use warnings;
                    use strict 'refs';
                    my $self = shift @_;
                    bless \my($scalar), $subclass;
                  };
$HASH2 = {
           ISA => *WTF::more::ISA,
           new => *WTF::more::new
         };
*WTF::more::ISA = [ 'WTF' ];
*WTF::more::new = sub {
                    package WTF;
                    use warnings;
                    use strict 'refs';
                    my $self = shift @_;
                    bless \my($scalar), $subclass_eclipse_1;
                  };

    [download]
    You might also consider using Test::Class to manage the growing complexity of your test suite.
[reply]
[d/l]
[select]
      Thanx for the tip Arunbear , but, as I hinted in my original posting, I simplified the actual implementation in which I saw the problem - in that, there are in fact (currently) 3 package scoped variables ... love the idea tho'.

      Thanx also for the tip on Test::Class - didn't notice it in the Testers Lab book (chromatic at al)...

      Rgds to all,

      At last, a user level that overstates my experience :-))
[reply]

Back to Seekers of Perl Wisdom