Author: bernhard
Date: Tue Mar 14 14:53:28 2006
New Revision: 11904
Modified:
trunk/docs/tests.pod
trunk/lib/Parrot/Distribution.pm
trunk/lib/Parrot/Docs/Directory.pm
trunk/t/README
trunk/t/perl/Parrot_Distribution.t
trunk/t/perl/Parrot_IO.t
trunk/t/perl/Parrot_Test.t
trunk/t/perl/README
trunk/t/perl/cppcomments.t
trunk/t/perl/manifest.t
Log:
Explain what t/perl is for.
Add a couple of tests, detabify and add a couple of ()
Modified: trunk/docs/tests.pod
==============================================================================
--- trunk/docs/tests.pod (original)
+++ trunk/docs/tests.pod Tue Mar 14 14:53:28 2006
@@ -76,7 +76,7 @@
=head2 Parrot Intermediate Representation
-Tests can also be written in B<PIR>. This is done with C<pir_output_is> and
+Writing tests in B<PIR> is more convenient. This is done with
C<pir_output_is> and
friends.
pir_output_is(<<'CODE',<<'OUT','nothing useful');
@@ -131,6 +131,10 @@
code executed completely. When mixing C<printf> and C<PIO_printf> always append
a C<fflush(stdout);> after the former.
+=head2 Test Perl5 helpers
+
+Perl5 unit tests are in F<t/perl/*.t>.
+
=head2 Testing language implementations
Language implementations are usually tested with the test function
@@ -179,5 +183,6 @@
=head1 SEE ALSO
L<http://qa.perl.org/>
+F<t/TESTS.STATUS.pod>
=cut
Modified: trunk/lib/Parrot/Distribution.pm
==============================================================================
--- trunk/lib/Parrot/Distribution.pm (original)
+++ trunk/lib/Parrot/Distribution.pm Tue Mar 14 14:53:28 2006
@@ -31,6 +31,7 @@
use strict;
use warnings;
+use 5.008;
use Data::Dumper;
use ExtUtils::Manifest;
@@ -39,7 +40,7 @@
use Parrot::Configure::Step qw(capture_output);
use Parrot::Docs::Directory;
-our @ISA = qw(Parrot::Docs::Directory);
+use base qw(Parrot::Docs::Directory);
=item C<new()>
@@ -93,12 +94,9 @@
my $self = shift;
return
- $self->directory_with_name('compilers')
- ->directory_with_name('ast'),
- $self->directory_with_name('compilers')
- ->directory_with_name('imcc'),
- $self->directory_with_name('examples')
- ->directory_with_name('c'),
+ $self->directory_with_name('compilers')->directory_with_name('ast'),
+ $self->directory_with_name('compilers')->directory_with_name('imcc'),
+ $self->directory_with_name('examples')->directory_with_name('c'),
$self->directory_with_name('src'),
$self->directory_with_name('src/encodings'),
$self->directory_with_name('src/io'),
@@ -127,6 +125,7 @@
}
print 'WARNING: ' . __FILE__ . ':' . __LINE__ . ' File not found:' . $name
."\n";
+
return;
}
@@ -284,3 +283,4 @@
=cut
1;
+
Modified: trunk/lib/Parrot/Docs/Directory.pm
==============================================================================
--- trunk/lib/Parrot/Docs/Directory.pm (original)
+++ trunk/lib/Parrot/Docs/Directory.pm Tue Mar 14 14:53:28 2006
@@ -7,7 +7,7 @@
=head1 SYNOPSIS
- use Parrot::Docs::Directory;
+ use Parrot::Docs::Directory;
=head1 DESCRIPTION
@@ -38,7 +38,7 @@
sub file_class
{
- return 'Parrot::Docs::File';
+ return 'Parrot::Docs::File';
}
=item C<directory_class()>
@@ -49,7 +49,7 @@
sub directory_class
{
- return 'Parrot::Docs::Directory';
+ return 'Parrot::Docs::Directory';
}
=back
@@ -68,32 +68,32 @@
sub files_of_type
{
- my $self = shift;
- my $type = shift;
-
- return () unless defined $type;
-
- my $recursive = shift;
- my $ignore = shift;
- my @files = ();
-
- foreach my $file ($self->files)
- {
- next unless $file->is_of_type($type);
- push @files, $file;
- }
-
- if ( $recursive )
- {
- foreach my $dir ($self->directories)
- {
- next if defined $ignore and $dir->name =~ /$ignore/;
-
- push @files, $dir->files_of_type($type, 1, $ignore);
- }
- }
-
- return @files;
+ my $self = shift;
+ my $type = shift;
+
+ return () unless defined $type;
+
+ my $recursive = shift;
+ my $ignore = shift;
+ my @files = ();
+
+ foreach my $file ($self->files())
+ {
+ next unless $file->is_of_type($type);
+ push @files, $file;
+ }
+
+ if ( $recursive )
+ {
+ foreach my $dir ($self->directories())
+ {
+ next if defined $ignore and $dir->name =~ /$ignore/;
+
+ push @files, $dir->files_of_type($type, 1, $ignore);
+ }
+ }
+
+ return @files;
}
=back
@@ -108,4 +108,4 @@
=cut
-1;
\ No newline at end of file
+1;
Modified: trunk/t/README
==============================================================================
--- trunk/t/README (original)
+++ trunk/t/README Tue Mar 14 14:53:28 2006
@@ -2,7 +2,7 @@
# $Id$
This directory contains the Parrot test suite.
-For details, see the documentation in 'docs/tests.pod'.
+For details, see the documentation in '../docs/tests.pod'.
For status of the testing effort, see 'TESTS.STATUS.pod' in this directory.
benchmark: Run all benchmarks
@@ -25,7 +25,7 @@
op: Try to cover all core operators
-perl: Tests written in Perl5. XXX Is this a meaningful category?
+perl: Test Perl5 modules used for configuration, building and testing
of Parrot.
pmc: Try to cover all builtin PMCs
Modified: trunk/t/perl/Parrot_Distribution.t
==============================================================================
--- trunk/t/perl/Parrot_Distribution.t (original)
+++ trunk/t/perl/Parrot_Distribution.t Tue Mar 14 14:53:28 2006
@@ -1,11 +1,11 @@
#! perl
-# Copyright: 2001-2005 The Perl Foundation. All Rights Reserved.
+# Copyright: 2001-2006 The Perl Foundation. All Rights Reserved.
# $Id$
use strict;
use warnings;
use lib qw( . lib ../lib ../../lib );
-use Test::More 'tests' => 5;
+use Test::More 'tests' => 8;
=head1 NAME
@@ -24,13 +24,17 @@
BEGIN { use_ok('Parrot::Distribution') };
die "Run these tests from the distribution root\n" unless -d 't/perl';
+
+# search upwards
chdir 't/perl';
-my( $d, $f);
-$d = Parrot::Distribution->new;
-ok($d, 'find distribution');
-$f = $d->c_source_file_with_name('pf_items');
-ok($f, 'C source file');
-$f = $d->c_header_file_with_name('parrot');
-ok($f, 'C header file');
-$f = $d->file_for_perl_module('Parrot::Docs::Section::Parrot');
-ok($f, 'Perl module file');
+my $d = Parrot::Distribution->new();
+isa_ok($d, 'Parrot::Docs::Directory');
+
+ok($d->c_source_file_with_name('pf_items'), 'C source file');
+ok( ! $d->c_source_file_with_name('dummy'), 'C source file not there');
+
+ok($d->c_header_file_with_name('parrot'), 'C header file');
+ok( ! $d->c_header_file_with_name('dummy'), 'C header file not there');
+
+ok($d->file_for_perl_module('Parrot::Docs::Section::Parrot'), 'Perl module
file');
+ok( ! $d->file_for_perl_module('Parrot::Dummy'), 'Perl module file not there');
Modified: trunk/t/perl/Parrot_IO.t
==============================================================================
--- trunk/t/perl/Parrot_IO.t (original)
+++ trunk/t/perl/Parrot_IO.t Tue Mar 14 14:53:28 2006
@@ -1,5 +1,5 @@
#! perl
-# Copyright: 2001-2005 The Perl Foundation. All Rights Reserved.
+# Copyright: 2001-2006 The Perl Foundation. All Rights Reserved.
# $Id$
use strict;
@@ -33,7 +33,7 @@
=cut
-# Path is really only an abstract superclass but there's a few things we
+# Path is really only an abstract superclass but there are a few things we
# can do with it.
BEGIN { use_ok('Parrot::IO::Path') };
@@ -46,26 +46,26 @@
# Path parsing.
ok($p, 'new');
-ok($p->has_suffix, 'has_suffix none');
+ok($p->has_suffix(), 'has_suffix none');
ok($p->has_suffix($suffix), 'has_suffix correct');
ok(!$p->has_suffix('foo'), 'has_suffix incorrect');
-is($p->suffix, $suffix, 'suffix');
-is($p->name, $fullname, 'name');
-is($p->name_without_suffix, $name, 'name_without_suffix');
+is($p->suffix(), $suffix, 'suffix');
+is($p->name(), $fullname, 'name');
+is($p->name_without_suffix(), $name, 'name_without_suffix');
# Check we get the same instance each time.
is($p, Parrot::IO::Path->new($tmpfile), 'instance cached');
-my $oldp = "$p";
-$p->delete;
+my $oldp = $p;
+$p->delete();
ok(! defined $p, 'delete undefines instance');
-# This won't actually create the file on disk.
+# This will not create the file on disk.
$p = Parrot::IO::Path->new($tmpfile);
isnt($oldp, $p, 'delete from cache');
-is($p->parent_path, tmp_dir_path(), 'parent_path');
+is($p->parent_path(), tmp_dir_path(), 'parent_path');
my $r = Parrot::IO::Path->new(rootdir);
-ok(!$r->parent_path, 'root has no parent_path');
+ok(!$r->parent_path(), 'root has no parent_path');
teardown();
@@ -73,7 +73,7 @@
BEGIN { use_ok('Parrot::IO::File') };
$r = Parrot::IO::Directory->new(rootdir);
-ok(!$r->parent, 'root has no parent');
+ok(!$r->parent(), 'root has no parent');
my $d = Parrot::IO::Directory->tmp_directory('t');
ok($d, 'tmp_directory');
@@ -183,42 +183,42 @@
is(@a, 0, 'directory delete');
ok(! defined $d2, 'delete undefined directory');
-$d->delete_contents;
[EMAIL PROTECTED] = $d->file_and_directory_paths;
+$d->delete_contents();
[EMAIL PROTECTED] = $d->file_and_directory_paths();
is(@a, 0, 'delete_contents');
teardown();
sub teardown
{
- unlink(tmp_file_path(qw(t one two file2.foo)));
- unlink(tmp_file_path(qw(t one two file3.bar)));
- unlink(tmp_file_path(qw(t one file1.txt)));
- rmdir(tmp_dir_path(qw(t one two)));
- rmdir(tmp_dir_path(qw(t one)));
- rmdir(tmp_dir_path('t'));
+ unlink(tmp_file_path(qw(t one two file2.foo)));
+ unlink(tmp_file_path(qw(t one two file3.bar)));
+ unlink(tmp_file_path(qw(t one file1.txt)));
+ rmdir(tmp_dir_path(qw(t one two)));
+ rmdir(tmp_dir_path(qw(t one)));
+ rmdir(tmp_dir_path('t'));
}
# tmp_dir_path(@dirs)
sub tmp_dir_path
{
- return catdir(tmpdir, @_);
+ return catdir(tmpdir, @_);
}
# tmp_file_path(@dirs, $file)
sub tmp_file_path
{
- my $file;
+ my $file;
- if ( @_ == 1 )
- {
- $file = catfile(tmp_dir_path(), shift);
- }
- else
- {
- $file = pop(@_);
- $file = catfile(tmp_dir_path(@_), $file);
- }
-
- return $file;
+ if ( @_ == 1 )
+ {
+ $file = catfile(tmp_dir_path(), shift);
+ }
+ else
+ {
+ $file = pop(@_);
+ $file = catfile(tmp_dir_path(@_), $file);
+ }
+
+ return $file;
}
Modified: trunk/t/perl/Parrot_Test.t
==============================================================================
--- trunk/t/perl/Parrot_Test.t (original)
+++ trunk/t/perl/Parrot_Test.t Tue Mar 14 14:53:28 2006
@@ -14,7 +14,7 @@
=head1 SYNOPSIS
- % prove t/perl/Parrot_Test.t
+ % prove t/perl/Parrot_Test.t
=head1 DESCRIPTION
@@ -63,5 +63,4 @@
### TODO generate_code, plan, skip, slurp_file, _generate_functions,
(generated functions), example_output_is
-
# vim: expandtab shiftwith=4
Modified: trunk/t/perl/README
==============================================================================
--- trunk/t/perl/README (original)
+++ trunk/t/perl/README Tue Mar 14 14:53:28 2006
@@ -1,5 +1,6 @@
-# Copyright: 2003-2005 The Perl Foundation. All Rights Reserved.
+# Copyright: 2003-2006 The Perl Foundation. All Rights Reserved.
# $Id$
-This directory contains test code written in Perl5.
+This directory contains test code for Perl5 modules used as helpers for Parrot.
See also the documentation in ../../docs/tests.pod.
+See also ../t/configure.
Modified: trunk/t/perl/cppcomments.t
==============================================================================
--- trunk/t/perl/cppcomments.t (original)
+++ trunk/t/perl/cppcomments.t Tue Mar 14 14:53:28 2006
@@ -4,6 +4,7 @@
use strict;
use warnings;
+use 5.008;
use lib qw( . lib ../lib ../../lib );
use Test::More tests => 1;
@@ -21,6 +22,12 @@
Checks that no source file in the distribution uses C++ style comments.
+=head1 TODO
+
+'t/perl' is not really the correct location for this test.
+
+Use Parrot::Distribution for looking for C-source files.
+
=cut
Modified: trunk/t/perl/manifest.t
==============================================================================
--- trunk/t/perl/manifest.t (original)
+++ trunk/t/perl/manifest.t Tue Mar 14 14:53:28 2006
@@ -21,6 +21,10 @@
Checks that the distribution and the MANIFEST file agree.
+=head1 TODO
+
+The file make more sense in 't/distro', but still be run by 'make test'.
+
=cut
