[libcatmandu-mab2-perl] 17/35: add tests for warnings
Jonas Smedegaard
dr at jones.dk
Fri Oct 27 17:54:41 UTC 2017
This is an automated email from the git hooks/post-receive script.
js pushed a commit to annotated tag debian/0.21-1
in repository libcatmandu-mab2-perl.
commit fa21cb2ec7a366c764e4c3f6ded31ce74d4f341f
Author: Johann Rolschewski <jorol at cpan.org>
Date: Thu Oct 12 14:16:06 2017 +0200
add tests for warnings
---
t/00-load.t | 2 +
t/01-parser.t | 118 ++++++++++++++++++++++++++++++++++++--------------
t/mab2_faulty.dat | 3 ++
t/mab2disk_faulty.dat | 6 +++
4 files changed, 96 insertions(+), 33 deletions(-)
diff --git a/t/00-load.t b/t/00-load.t
index 33a5f31..a56902a 100644
--- a/t/00-load.t
+++ b/t/00-load.t
@@ -6,6 +6,7 @@ BEGIN {
use_ok 'Catmandu::Importer::MAB2';
use_ok 'Catmandu::Exporter::MAB2';
use_ok 'Catmandu::Fix::mab_map';
+ use_ok 'MAB2::Parser::Disk';
use_ok 'MAB2::Parser::RAW';
use_ok 'MAB2::Parser::XML';
use_ok 'MAB2::Writer::RAW';
@@ -16,6 +17,7 @@ BEGIN {
require_ok 'Catmandu::Importer::MAB2';
require_ok 'Catmandu::Exporter::MAB2';
require_ok 'Catmandu::Fix::mab_map';
+require_ok 'MAB2::Parser::Disk';
require_ok 'MAB2::Parser::RAW';
require_ok 'MAB2::Parser::XML';
require_ok 'MAB2::Writer::RAW';
diff --git a/t/01-parser.t b/t/01-parser.t
index 86f7212..a27aaca 100644
--- a/t/01-parser.t
+++ b/t/01-parser.t
@@ -1,38 +1,90 @@
use strict;
use warnings;
use Test::More;
+use Test::Warn;
use utf8;
-use MAB2::Parser::XML;
-my $parser = MAB2::Parser::XML->new( './t/mab2.xml' );
-isa_ok( $parser, 'MAB2::Parser::XML' );
-my $record = $parser->next();
-ok($record->{_id} eq '47918-4', 'record _id' );
-is_deeply($record->{record}->[0], ['001', ' ', '_', '47918-4'], 'first field');
-ok($parser->next()->{_id} eq '54251-9', 'next record');
-
-$parser = MAB2::Parser::XML->new( q{<datensatz typ="h" status="n" mabVersion="M2.0" xmlns="http://www.ddb.de/professionell/mabxml/mabxml-1.xsd"><feld nr="001" ind=" ">47918-4</feld><feld nr="002" ind="a">19991118</feld><feld nr="003" ind=" ">20101112110154</feld><feld nr="004" ind=" ">20110211</feld><feld nr="016" ind=" ">550915044<tf/>DNB</feld><feld nr="025" ind="a">010420517</feld><feld nr="025" ind="o">85117764</feld><feld nr="025" ind="z">47918-4</feld><feld nr="026" ind=" ">ZDB4791 [...]
-isa_ok( $parser, 'MAB2::Parser::XML' );
-$record = $parser->next();
-ok($record->{_id} eq '47918-4', 'record _id' );
-is_deeply($record->{record}->[0], ['001', ' ', '_', '47918-4'], 'first field');
-
-use MAB2::Parser::RAW;
-$parser = MAB2::Parser::RAW->new( './t/mab2.dat' );
-isa_ok( $parser, 'MAB2::Parser::RAW' );
-$record = $parser->next();
-ok($record->{_id} eq '47918-4', 'record _id' );
-ok($record->{record}->[0][3] eq '02020nM2.01200024 h', 'record leader' );
-is_deeply($record->{record}->[1], ['001', ' ', '_', '47918-4'], 'first field');
-ok($parser->next()->{_id} eq '54251-9', 'next record');
-
-use MAB2::Parser::Disk;
-$parser = MAB2::Parser::Disk->new( './t/mab2disk.dat' );
-isa_ok( $parser, 'MAB2::Parser::Disk' );
-$record = $parser->next();
-ok($record->{_id} eq '47918-4', 'record _id' );
-ok($record->{record}->[0][3] eq '02020nM2.01200024 h', 'record leader' );
-is_deeply($record->{record}->[1], ['001', ' ', '_', '47918-4'], 'first field');
-ok($parser->next()->{_id} eq '54251-9', 'next record');
-
-done_testing;
\ No newline at end of file
+note 'MAB2::Parser::XML';
+{
+ use MAB2::Parser::XML;
+ my $parser = MAB2::Parser::XML->new('./t/mab2.xml');
+ isa_ok( $parser, 'MAB2::Parser::XML' );
+ my $record = $parser->next();
+ ok( $record->{_id} eq '47918-4', 'record _id' );
+ is_deeply(
+ $record->{record}->[0],
+ [ '001', ' ', '_', '47918-4' ],
+ 'first field'
+ );
+ ok( $parser->next()->{_id} eq '54251-9', 'next record' );
+
+ $parser
+ = MAB2::Parser::XML->new(
+ q{<datensatz typ="h" status="n" mabVersion="M2.0" xmlns="http://www.ddb.de/professionell/mabxml/mabxml-1.xsd"><feld nr="001" ind=" ">47918-4</feld><feld nr="002" ind="a">19991118</feld><feld nr="003" ind=" ">20101112110154</feld><feld nr="004" ind=" ">20110211</feld><feld nr="016" ind=" ">550915044<tf/>DNB</feld><feld nr="025" ind="a">010420517</feld><feld nr="025" ind="o">85117764</feld><feld nr="025" ind="z">47918-4</feld><feld nr="026" ind=" ">ZDB47918-4</feld><feld nr="030" i [...]
+ );
+ isa_ok( $parser, 'MAB2::Parser::XML' );
+ $record = $parser->next();
+ ok( $record->{_id} eq '47918-4', 'record _id' );
+ is_deeply(
+ $record->{record}->[0],
+ [ '001', ' ', '_', '47918-4' ],
+ 'first field'
+ );
+}
+
+note 'MAB2::Parser::RAW';
+{
+ use MAB2::Parser::RAW;
+ my $parser = MAB2::Parser::RAW->new('./t/mab2.dat');
+ isa_ok( $parser, 'MAB2::Parser::RAW' );
+ my $record = $parser->next();
+ ok( $record->{_id} eq '47918-4', 'record _id' );
+ ok( $record->{record}->[0][3] eq '02020nM2.01200024 h',
+ 'record leader' );
+ is_deeply(
+ $record->{record}->[1],
+ [ '001', ' ', '_', '47918-4' ],
+ 'first field'
+ );
+ ok( $parser->next()->{_id} eq '54251-9', 'next record' );
+}
+
+note 'MAB2::Parser::RAW warnings';
+{
+
+ use MAB2::Parser::RAW;
+ my $parser = MAB2::Parser::RAW->new('./t/mab2_faulty.dat');
+ warning_like {$parser->next()} qr/^record terminator not found/, "got warning record terminator";
+ warning_like {$parser->next()} qr/^faulty record leader/, "got warning faulty leader";
+ warning_like {$parser->next()} qr/^faulty field structure/, "got warning faulty field";
+}
+
+note 'MAB2::Parser::Disk';
+{
+
+ use MAB2::Parser::Disk;
+ my $parser = MAB2::Parser::Disk->new('./t/mab2disk.dat');
+ isa_ok( $parser, 'MAB2::Parser::Disk' );
+ my $record = $parser->next();
+ ok( $record->{_id} eq '47918-4', 'record _id' );
+ ok( $record->{record}->[0][3] eq '02020nM2.01200024 h',
+ 'record leader' );
+ is_deeply(
+ $record->{record}->[1],
+ [ '001', ' ', '_', '47918-4' ],
+ 'first field'
+ );
+ ok( $parser->next()->{_id} eq '54251-9', 'next record' );
+
+}
+
+note 'MAB2::Parser::Disk warnings';
+{
+
+ use MAB2::Parser::Disk;
+ my $parser = MAB2::Parser::Disk->new('./t/mab2disk_faulty.dat');
+ warning_like {$parser->next()} qr/^faulty record leader/, "got warning faulty leader";
+ warning_like {$parser->next()} qr/^faulty field structure/, "got warning faulty field";
+}
+
+done_testing;
diff --git a/t/mab2_faulty.dat b/t/mab2_faulty.dat
new file mode 100644
index 0000000..cda62b5
--- /dev/null
+++ b/t/mab2_faulty.dat
@@ -0,0 +1,3 @@
+02020nM2.01200024 h001 47918-4
+0202XnM2.01200024 h001 47918-4
+02020nM2.01200024 h001 47918-4
025#010420517
\ No newline at end of file
diff --git a/t/mab2disk_faulty.dat b/t/mab2disk_faulty.dat
new file mode 100644
index 0000000..bbb5e28
--- /dev/null
+++ b/t/mab2disk_faulty.dat
@@ -0,0 +1,6 @@
+### 0202XnM2.01200024 h
+001 47918-4
+
+### 02020nM2.01200024 h
+001 47918-4
+025#010420517
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libcatmandu-mab2-perl.git
More information about the Pkg-perl-cvs-commits
mailing list