# New Ticket Created by  "Paul Cochrane" 
# Please include the string:  [perl #40544]
# in the subject line of all future correspondence about this issue. 
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=40544 >


Hi,

This patch adds a test for DOS line endings in text files in the
Parrot distribution.

Comments welcome,

Paul

files affected:
MANIFEST
t/codingstd/line_endings.t
Index: MANIFEST
===================================================================
--- MANIFEST	(revision 14906)
+++ MANIFEST	(working copy)
@@ -2446,6 +2446,7 @@
 t/codingstd/cppcomments.t                                   []
 t/codingstd/cuddled_else.t                                  []
 t/codingstd/fixme.t                                         []
+t/codingstd/line_endings.t                                  []
 t/codingstd/linelength.t                                    []
 t/codingstd/perlcritic.t                                    []
 t/codingstd/tabs.t                                          []
Index: t/codingstd/line_endings.t
===================================================================
--- t/codingstd/line_endings.t	(revision 0)
+++ t/codingstd/line_endings.t	(revision 0)
@@ -0,0 +1,92 @@
+#! perl
+# Copyright (C) 2006, The Perl Foundation.
+# $Id$
+
+use strict;
+use warnings;
+
+use lib qw( . lib ../lib ../../lib );
+use Test::More tests => 1;
+use ExtUtils::Manifest qw(maniread);
+use SVN::Client;
+
+=head1 NAME
+
+t/codingstd/line_endings.t - checks for DOS line endings in text files
+
+=head1 SYNOPSIS
+
+    # test all files
+    % prove t/codingstd/line_endings.t
+
+    # test specific files
+    % perl t/codingstd/line_endings.t src/foo.c include/parrot/bar.h
+
+=head1 DESCRIPTION
+
+Checks that text files do not have DOS (CRLF) line endings.  Instead, they
+should have Unix (CR) line endings.
+
+=head1 SEE ALSO
+
+L<docs/pdds/pdd07_codingstd.pod>
+
+=cut
+
+my @files = @ARGV ? @ARGV : source_files();
+my @dos_files;
+
+foreach my $file (@files) {
+    my $buf;
+
+    # slurp in the file
+    open( my $fh, '<', $file )
+        or die "Cannot open '$file' for reading: $!\n";
+    {
+        local $/;
+        $buf = <$fh>;
+    }
+
+    # append to the dos_files array if the code matches
+    push @dos_files => "$file\n"
+        if $buf =~ m{\r$}m;
+}
+
+ok( !scalar(@dos_files), 'Line endings correct' )
+    or diag( "DOS line ending found in " . scalar @dos_files . " files:[EMAIL PROTECTED]" );
+
+sub source_files
+{
+    my $client = SVN::Client->new();
+    my $manifest = maniread('MANIFEST');
+    my @test_files;
+    # grab names of files to test (except binary files)
+    foreach my $filename ( sort keys %$manifest ) {
+        # try to read the svn:mime-type property of the file
+        my $prop_ref = $client->propget("svn:mime-type", $filename, "WORKING", 0);
+
+        # if we have no mime-type property set or the mime-type is text/*
+        # then the file is text (this is the assumption used by subversion)
+        my $prop = $prop_ref->{$filename};
+        # of the mime-type property is undefined, append to the file list
+        if (!defined $prop) {
+            push @test_files, $filename;
+        }
+        else {
+            # if we know we have a text file, append it
+            push @test_files, $filename
+                if ($prop =~ m{text});
+        }
+    }
+
+    return @test_files;
+}
+
+exit;
+
+# Local Variables:
+#   mode: cperl
+#   cperl-indent-level: 4
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:

Reply via email to