[svn:parrot] r39940 - branches/darwinhints/lib/Parrot/Configure/Options/Test

jkeenan at svn.parrot.org jkeenan at svn.parrot.org
Wed Jul 8 01:20:49 UTC 2009


Author: jkeenan
Date: Wed Jul  8 01:20:48 2009
New Revision: 39940
URL: https://trac.parrot.org/parrot/changeset/39940

Log:
Modify to accommodate two levels in t/steps/.

Modified:
   branches/darwinhints/lib/Parrot/Configure/Options/Test/Prepare.pm

Modified: branches/darwinhints/lib/Parrot/Configure/Options/Test/Prepare.pm
==============================================================================
--- branches/darwinhints/lib/Parrot/Configure/Options/Test/Prepare.pm	Tue Jul  7 23:04:08 2009	(r39939)
+++ branches/darwinhints/lib/Parrot/Configure/Options/Test/Prepare.pm	Wed Jul  8 01:20:48 2009	(r39940)
@@ -4,6 +4,9 @@
 use strict;
 use warnings;
 use Carp;
+use Data::Dumper;$Data::Dumper::Indent=1;
+use File::Find;
+#use Scalar::Util qw( looks_like_number );
 use base qw( Exporter );
 our @EXPORT_OK = qw(
     get_preconfiguration_tests
@@ -16,11 +19,12 @@
 my @framework_tests = _get_framework_tests($config_dir);
 
 my $steps_dir = q{t/steps};
-my $steps_tests_ref  = _find_steps_tests($steps_dir);
+my ( $steps_tests_simple_ref, $steps_tests_complex_ref )  =
+    _find_steps_tests($steps_dir);
 my @steps_expected = get_steps_list();
 my @steps_tests = _prepare_steps_tests_list(
     $steps_dir,
-    $steps_tests_ref,
+    $steps_tests_complex_ref,
     \@steps_expected,
 );
 
@@ -52,61 +56,34 @@
     return @framework_tests;
 }
 
-# _find_steps_tests() currently returns a ref to a seen-hash of .t files found
-# in t/steps/*.t.  The hash has 4 elements, 'init', 'inter', 'auto' and 'gen'.
-# The value of each such element is another hash where each element
-# corresponds to the (1 or more) tests for each configuration step.  The key
-# of that hash is the second part of the step's name, and its value is a
-# reference to another seen-hash where each element is the 2-digit, 0-padded
-# number of the test.
-#
-#  $steps_tests_ref = {
-#    'auto' => {
-#      ...
-#    },
-#    'gen' => {
-#      ...
-#    },
-#    'inter' => {
-#      'lex' => {
-#        '01' => 1,
-#        '02' => 1,
-#        '03' => 1,
-#      },
-#      ...
-#    },
-#    'init' => {
-#      'manifest' => {
-#        '01' => 1
-#      },
-#      ...
-#      'hints' => {
-#        '01' => 1
-#      },
-#      ...
-#    },
-#  };
-
+my %steps_tests_simple = ();
+my %steps_tests_complex = ();
 sub _find_steps_tests {
     my $steps_dir = shift;
-    my %steps_tests = ();
-    # Will have to alter this to reflect repositioning of steps tests and
-    # possibility of 2nd level tests.
-    # We should continue to carp if there are no tests for a top-level step
-    # class.
-    opendir my $DIRH2, $steps_dir or croak "Unable to open $steps_dir";
-    for my $t (grep { /\.t$/ } readdir $DIRH2) {
-        my ($type, $class, $num);
-        if ($t =~ m/(init|inter|auto|gen)_(\w+)-(\d{2})\.t$/) {
-            ($type, $class, $num) = ($1,$2,$3);
-            $steps_tests{$type}{$class}{$num}++;
-        }
-        else {
-            carp "Unable to match $t";
+    sub wanted {
+        if ( $File::Find::name =~
+            m<
+                (init|inter|auto|gen) # category
+                /
+                ([a-z_\d]+) # class
+                (?:/
+                ([a-z_]+) # second-level
+                )?        # may not be defined
+                -
+                (\d{2}) # number
+                \.t$
+            >x ) {
+            $steps_tests_simple{$File::Find::name}++;
+            my ($category, $class, $secondlevel, $number) =
+                ($1, $2, $3 || q{}, $4);
+            my $final = ( $secondlevel )
+                ? qq|$secondlevel-$number|
+                : $number;
+            $steps_tests_complex{$category}{$class}{$final}++;
         }
-    }
-    closedir $DIRH2 or croak "Unable to close $steps_dir";
-    return \%steps_tests;
+    } # END wanted()
+    finddepth( \&wanted, ( $steps_dir ) );
+    return ( \%steps_tests_simple, \%steps_tests_complex );
 }
 
 sub _prepare_steps_tests_list {
@@ -114,16 +91,22 @@
     my $steps_tests_ref = shift;
     my $steps_expected_ref = shift;
     my @steps_tests;
-    # The order of config steps should still be governed by
-    # Parrot::Configure::Step::List::get_steps_list.
+    # The order of tests of config steps is governed by
+    # Parrot::Configure::Step::List::get_steps_list().
     foreach my $step ( @{ $steps_expected_ref } ) {
         my @module_path = split /::/, $step;
-        # Will have to how $these_steps gets assigned to
-        # in order to accommodate 2nd level tests.
         my $these_tests = $steps_tests_ref->{$module_path[0]}{$module_path[1]}
             or carp "No tests exist for configure step $step";
         foreach my $k (sort keys %$these_tests) {
-            push @steps_tests, qq{$steps_dir/$module_path[0]_$module_path[1]-$k.t};
+            if ( $k =~ m/^(\w+)-(\d{2})$/ ) {
+                my ($secondlevel, $number) = ($1, $2);
+                push @steps_tests,
+                    qq{$steps_dir/$module_path[0]/$module_path[1]/$secondlevel-$number.t};
+            }
+            else {
+                push @steps_tests,
+                    qq{$steps_dir/$module_path[0]/$module_path[1]-$k.t};
+            }
         }
     }
     return @steps_tests;


More information about the parrot-commits mailing list