Permalink
Browse files

Explain what t/perl is for.

Add a couple of tests, detabify and add a couple of ()


git-svn-id: https://svn.parrot.org/parrot/trunk@11904 d31e2699-5ff4-0310-a27c-f18f2fbe73fe
  • Loading branch information...
1 parent a43e9b6 commit b9beb9d35aa843287534af1004e897bb053113e0 @bschmalhofer bschmalhofer committed Mar 14, 2006
Showing with 108 additions and 88 deletions.
  1. +6 −1 docs/tests.pod
  2. +7 −7 lib/Parrot/Distribution.pm
  3. +30 −30 lib/Parrot/Docs/Directory.pm
  4. +2 −2 t/README
  5. +15 −11 t/perl/Parrot_Distribution.t
  6. +33 −33 t/perl/Parrot_IO.t
  7. +1 −2 t/perl/Parrot_Test.t
  8. +3 −2 t/perl/README
  9. +7 −0 t/perl/cppcomments.t
  10. +4 −0 t/perl/manifest.t
View
@@ -76,7 +76,7 @@ new test like this:
=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 @@ Note that it's always a good idea to output "done" to confirm that the compiled
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 @@ See L<Test::More> on how to do that.
=head1 SEE ALSO
L<http://qa.perl.org/>
+F<t/TESTS.STATUS.pod>
=cut
@@ -31,6 +31,7 @@ package Parrot::Distribution;
use strict;
use warnings;
+use 5.008;
use Data::Dumper;
use ExtUtils::Manifest;
@@ -39,7 +40,7 @@ use Parrot::Revision;
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 @@ sub c_source_file_directories
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 @@ sub c_source_file_with_name
}
print 'WARNING: ' . __FILE__ . ':' . __LINE__ . ' File not found:' . $name ."\n";
+
return;
}
@@ -284,3 +283,4 @@ sub gen_manifest_skip {
=cut
1;
+
@@ -7,7 +7,7 @@ Parrot::Docs::Directory - Docs-Related Directory
=head1 SYNOPSIS
- use Parrot::Docs::Directory;
+ use Parrot::Docs::Directory;
=head1 DESCRIPTION
@@ -38,7 +38,7 @@ Returns C<Parrot::Docs::File>.
sub file_class
{
- return 'Parrot::Docs::File';
+ return 'Parrot::Docs::File';
}
=item C<directory_class()>
@@ -49,7 +49,7 @@ Returns C<Parrot::Docs::Directory>.
sub directory_class
{
- return 'Parrot::Docs::Directory';
+ return 'Parrot::Docs::Directory';
}
=back
@@ -68,32 +68,32 @@ C<$recursive> and C<$ignore> function as specified in C<files()>.
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 @@ sub files_of_type
=cut
-1;
+1;
View
@@ -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 @@ native_pbc: Parrot Byte Code
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
@@ -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 @@ t/perl/Parrot_Distribution.t - Parrot::Distribution unit tests
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');
View
@@ -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 @@ to ensure nothing is broken.
=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,34 +46,34 @@ my $p = Parrot::IO::Path->new($tmpfile);
# 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();
BEGIN { use_ok('Parrot::IO::Directory') };
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 @@ $d2->delete();
is(@a, 0, 'directory delete');
ok(! defined $d2, 'delete undefined directory');
-$d->delete_contents;
-@a = $d->file_and_directory_paths;
+$d->delete_contents();
+@a = $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;
}
@@ -14,7 +14,7 @@ t/perl/Parrot_Test.t - Parrot::Test unit tests
=head1 SYNOPSIS
- % prove t/perl/Parrot_Test.t
+ % prove t/perl/Parrot_Test.t
=head1 DESCRIPTION
@@ -63,5 +63,4 @@ is( Parrot::Test::per_test(undef, 0), undef, 'per_test() invalid args' );
### TODO generate_code, plan, skip, slurp_file, _generate_functions, (generated functions), example_output_is
-
# vim: expandtab shiftwith=4
View
@@ -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.
@@ -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 @@ t/src/cppcomments.t - checks for C++ style comments
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
Oops, something went wrong.

0 comments on commit b9beb9d

Please sign in to comment.