|
|
Author: particle
Date: Thu Jun 5 10:27:50 2008
New Revision: 28105
Added:
trunk/languages/perl6/tools/fudge_purity_inspector.pl (contents, props
changed)
Modified:
trunk/MANIFEST
Log:
#55346: [PATCH] tool for checking if '# pure' files still contain fudging
~ applied with minor formatting corrections and enhancements
Courtesy of Moritz Lenz (moritz++)
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST (original)
+++ trunk/MANIFEST Thu Jun 5 10:27:50 2008
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Wed Jun 4 20:37:00 2008 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Thu Jun 5 15:13:47 2008 UT
#
# See tools/dev/install_files.pl for documentation on the
# format of this file.
@@ -1963,6 +1963,7 @@
languages/perl6/t/pmc/mutable.t [perl6]
languages/perl6/t/pmc/mutablevar.t [perl6]
languages/perl6/t/spectest_regression.data [perl6]
+languages/perl6/tools/fudge_purity_inspector.pl [perl6]
languages/perl6/tools/update_passing_test_data.pl [perl6]
languages/pheme/MAINTAINER [pheme]
languages/pheme/MANIFEST [pheme]
Added: trunk/languages/perl6/tools/fudge_purity_inspector.pl
==============================================================================
--- (empty file)
+++ trunk/languages/perl6/tools/fudge_purity_inspector.pl Thu Jun 5
10:27:50 2008
@@ -0,0 +1,50 @@
+#! perl
+# Copyright (C) 2008, The Perl Foundation.
+# $Id$
+
+use strict;
+use warnings;
+
+
+my $input_file = shift @ARGV || 't/spectest_regression.data';
+my $impl = 'rakudo';
+
+open my $fh, '<', $input_file
+ or die "Can't open '$input_file' for reading: $!";
+
+my @files;
+
+while (<$fh>){
+ chomp;
+ next if m/^#/ || m/^\s*$/;
+ my ($file, $comment) = split m/\s*#\s*/;
+ if ($comment && $comment eq 'pure'){
+ push @files => check_file_and_warn($file);
+ }
+}
+
+if (@files) {
+ print "The following files contain fudge directives though they are marked
as pure:\n";
+ print "$_\n"
+ for @files;
+}
+else { print "all's well\n"; }
+
+
+sub check_file_and_warn {
+ my $filename = shift;
+ $filename = "t/spec/$filename";
+# warn "checking file <$filename>\n";
+ open my $fh, '<', $filename
+ or die "Can't open file '$filename' for reading: $!";
+ my $re = qr{^\s*#\?$impl};
+ my @lines;
+ while (<$fh>) {
+ push @lines => $.
+ if m/$re/;
+ }
+ close $fh;
+
+ return @lines ? ("$filename, lines " . join( ', ' => @lines )) : ();
+}
+
|
|