#!/pro/bin/perl

use strict;
use warnings;

use File::Spec;
#use Test::More "no_plan";
use Test::More tests => 83;
use Test::NoWarnings;

BEGIN {
    use_ok ("VCS::SCCS");
    }

like (VCS::SCCS::version (),  qr{^\d+\.\d+$},	"Module version function");
like (VCS::SCCS->version (),  qr{^\d+\.\d+$},	"Module version method");

my $sccs;

my $testfile = "files/SCCS/s.base.dta";

sub e_is
{
    my ($expr, @args) = @_;
    my $msg = @args ? defined $args[0] ? qq{"$args[0]"} : "undef" : "";
    eval { $sccs = VCS::SCCS->new (@args) };
    is ($sccs, undef, "new->($msg)");
    like ($@, $expr,  ".. fail msg");
    } # e_is

ok (1, "Constructor");
    open my $empty, ">", "s.empty.c";
e_is (qr{needs a valid file name});
e_is (qr{needs a valid file name},		undef);
e_is (qr{needs a valid file name},		"");
e_is (qr{does not exist},			"xxxxx");
e_is (qr{is empty},				"s.empty.c");
    print $empty "Not anymore\n";
    close $empty;
    chmod 0000, "s.empty.c";	# Might not be effective on Win32 or cygwin!
e_is (qr{Cannot open|start with a checksum},	"s.empty.c");
    unlink "s.empty.c";
e_is (qr{is not a file|does not exist|nul is empty}, # Win32--
						File::Spec->devnull ());
e_is (qr{is not a file},			"files");
e_is (qr{start with a checksum},		"Makefile");

ok (1, "Parsing");
ok ($sccs = VCS::SCCS->new ($testfile), "Read and parse large SCCS file");

ok (1, "Metadata");
is ($sccs->file (),		"files/base.dta",	"file ()");
is ($sccs->checksum (),		52534,		"checksum ()");
is (scalar $sccs->current (),	70,		"current () scalar");
is_deeply ([ $sccs->current () ],
	[ 70, "5.39", 5, 39, undef, undef ],	"current () list");

ok (1, "Deltas");
is ($sccs->version,		"5.39",		"version ()");
is ($sccs->version (undef),	"5.39",		"version (undef)");
is ($sccs->version (0),		"5.39",		"version (0)");
is ($sccs->version (""),	"5.39",		"version ('')");
is ($sccs->version (53),	"5.22",		"version (53)");
is ($sccs->version (99),	undef,		"version (99)");
is ($sccs->revision,		70,		"revision ()");
is ($sccs->revision (undef),	70,		"revision (undef)");
is ($sccs->revision (0),	70,		"revision (0)");
is ($sccs->revision (""),	70,		"revision ('')");
is ($sccs->revision ("5.38"),	69,		"revision ('5.38')");
is ($sccs->revision ("9.99"),	undef,		"revision ('9.99')");

my $delta;
ok ($delta = $sccs->delta,			"delta ()");
is ($delta->{version},		"5.39",		"  {version}");
is ($delta->{release},		5,		"  {release}");
is ($delta->{level},		39,		"  {level}");
is ($delta->{branch},		undef,		"  {branch}");
is ($delta->{sequence},		undef,		"  {sequence}");
is ($delta->{date},		"07/11/09",	"  {date}");
ok ($delta = $sccs->delta (2),			"delta (2)");
is ($delta->{version},		"4.2",		"  {version}");
ok ($delta = $sccs->delta ("4.3"),		"delta ('4.3')");
is ($delta->{date},		"98/02/06",	"  {date}");
is ($delta = $sccs->delta (99),	undef,		"delta (99)");

my $f;
ok ($f = $sccs->flags (),			"flags ()");
is (ref $f,			"HASH",		".. is hashref");
my %f = %{$f};
ok (exists $f{q},				".. {q} exists");
is ($f{q},			"main_app",	".. {q} has value");
ok (exists $f{v},				".. {v} exists");
is ($f{v},			undef,		".. {v} has no value");

my @users;
ok (@users = $sccs->users (),			"users ()");
is (scalar @users,		3,		".. has 3 users");
is ($users[0],			"merijn",	".. user 0");
is ($users[1],			"testuser1",	".. user 1");
is ($users[2],			"testuser2",	".. user 2");

is ($sccs->comment (),		"test\n",	"comment ()");

my $revmap;
ok ($revmap = $sccs->revision_map (),		"revision_map ()");
is (ref $revmap,		"ARRAY",	".. is arrayref");
is (ref $revmap->[0],		"ARRAY",	".. of arrayrefs");
is ($revmap->[0][0],		1,		".. revision 1");
is ($revmap->[0][1],		"4.1",		".. version  4.1");
is ($revmap->[69][0],		70,		".. revision 70");
is ($revmap->[69][1],		"5.39",		".. version  5.39");

is (length ($sccs->body ()),		261840,	"body ()      scalar");
is (length ($sccs->body (0)),		261840,	"body (0)     scalar");
is (length ($sccs->body ("")),		261840,	"body ('')    scalar");
is (length ($sccs->body (2)),		160788,	"body (2)     scalar");
is (length ($sccs->body ("4.2")),	160788,	"body ('4.2') scalar");

my @body;
ok (@body = $sccs->body (),			"body ()      list");
is ($#body,			6484,		".. 6484 lines");
ok (@body = $sccs->body ("4.2"),		"body ('4.2') list");
is ($#body,			4237,		".. 4237 lines");