comment on

In line with your code here, this is my take on what one might want to see in an exporting module and its associated .t file. Note that it's not even necessary to go to the trouble of exporting stuff if you're willing to use fully-qualified subroutine names, e.g., TrigCalc::reduce(...);, in the client code — very convenient for smallish, quick-and-dirty modules (update: and still perfectly testable with Test::*). You can see that using a .t file to help specify a program and identify problem behaviors can be very helpful to all concerned.

The reduce() function in the .pm file is defined in terms of two non-exported functions. These two functions could easily have been folded into reduce() (it might even have simplified things a bit), but leaving them separate helps document the behavior of the parent function and also provides the opportunity to independently test these two component behaviors even though the functions embodying them are not exported.

TrigCalc.pm:

package TrigCalc;

use warnings;
use strict;

# use Data::Dump qw(dd pp);  # for debug

use parent 'Exporter';

our $VERSION = '0.1.0';

our @EXPORT    = qw();  # default exports: (none for now)
our @EXPORT_OK =        # optional exports
    qw(reduce)
    ;

use constant SECS_PER_DEGREE => 3600;
use constant SECS_PER_MINUTE =>   60;

# exported subroutines #############################################

sub reduce {

    # reduce from rightmost end of argument list.
    return secs_2_dms(dms_2_secs((reverse @_)[ 0 .. 2 ]));

    }

# non-exported (utility) subroutines ###############################

sub dms_2_secs {

    my ($secs,  # seconds
        $mins,  # minutes
        $degs,  # degrees
        ) = @_;

    $secs ||= 0;  # init as zero if undefined (or false: redundant)
    $mins ||= 0;
    $degs ||= 0;

    return $degs * SECS_PER_DEGREE + $mins * SECS_PER_MINUTE + $secs;

    }

sub secs_2_dms {

    use integer;

    my ($secs,  # seconds
        ) = @_;

    $secs ||= 0;  # init as zero if undefined (or false: redundant)

    my $degs = $secs / SECS_PER_DEGREE;   $secs %= SECS_PER_DEGREE;
    my $mins = $secs / SECS_PER_MINUTE;   $secs %= SECS_PER_MINUTE;

    return $degs, $mins, $secs;

    }

1;
[download]

TrigCalc.t (note that I've used a different result for the (0, 0, -60) test case):

use warnings;
use strict;

use Test::More 'no_plan';
use Test::NoWarnings;

use Data::Dump qw(pp);

note "testing under perl version $]";

BEGIN { use_ok 'TrigCalc', qw(reduce); }

my @TESTS = (
    'degenerate cases',
    [ [],                      [ 0, 0, 0 ], 'empty argument list'   ],
    [ [ undef ],               [ 0, 0, 0 ], 'undefined argument(s)' ],
    [ [ undef, undef ],        [ 0, 0, 0 ], 'undefined argument(s)' ],
    [ [ undef, undef, undef ], [ 0, 0, 0 ], 'undefined argument(s)' ],

    'irreducible cases',
    [ [ 123, 180, 59, 59 ],  [ 180, 59, 59 ], 'left ignored' ],
    [ [      180, 59, 59 ],  [ 180, 59, 59 ], ],
    [ [      180, 59, 58 ],  [ 180, 59, 58 ], ],
    [ [        1,  1,  1 ],  [   1,  1,  1 ], ],
    [ [        0,  0,  0 ],  [   0,  0,  0 ], ],
    [ [         -1,   -1,   -1 ],  [   -1,   -1,   -1 ], ],
    [ [       -180,  -59,  -58 ],  [ -180,  -59,  -58 ], ],
    [ [ -123, -180,  -59,  -59 ],  [ -180,  -59,  -59 ], 'left ignored
+' ],

    'reducible cases',
    [ [  179,    0,   60 ],      [  179,    1,    0 ], ],
    [ [  179,   61,   61 ],      [  180,    2,    1 ], ],
    [ [  179,   59,   60 ],      [  180,    0,    0 ], ],
    [ [ -179,   60,    0 ],      [ -178,    0,    0 ], 'reduction of n
+egatives' ],
  # [ [    0,    0,  -60 ],      [   -1,   59,    2 ], 'negative borro
+w'        ], # <-- ????
    [ [    0,    0,  -60 ],      [    0,   -1,    0 ], 'negative borro
+w'        ],
    [ [   90,  360,  360 ],      [   96,    6,    0 ], 'multiple reduc
+tion'     ],
    [ [   90, -360, -360 ],      [   83,   54,    0 ], 'multiple reduc
+tion'     ],

    'only rightmost arguments are reduced, others ignored',
    [ [              200,  179,    0,   60 ], [  179,    1,    0 ], ],
    [ [        200,  200,  179,    0,   60 ], [  179,    1,    0 ], ],
    [ [  200,  200,  200,  179,    0,   60 ], [  179,    1,    0 ], ],
    [ [              200,   90, -360, -360 ], [   83,   54,    0 ], ],
    [ [        200,  200,   90, -360, -360 ], [   83,   54,    0 ], ],
    [ [  200,  200,  200,   90, -360, -360 ], [   83,   54,    0 ], ],

    );

# just to be sure...
is_deeply [ reduce ], [ 0, 0, 0 ], 'REALLY empty argument list';

VECTOR:
for my $ar_vector (@TESTS) {

    # comments can be mixed into test vector list.
    if (not ref $ar_vector) {
        note "--- $ar_vector ---";  # actually a comment
        next VECTOR;
        }

    # expand test vector.
    my ($ar_args, $ar_expected, $cmnt) = @$ar_vector;

    # prepare fancy-shmancy test comment.
    $cmnt = defined $cmnt ? ": $cmnt" : '';
    my $args_str     = pp @$ar_args;
    my $expected_str = pp @$ar_expected;
    my $full_comment = "$args_str -> $expected_str$cmnt";

    # do it to it.
    is_deeply [ reduce(@$ar_args) ], $ar_expected, $full_comment;

    }  # end for VECTOR

# a way to test non-exported functions.

note "\n=== testing TrigCalc::dms_2_secs() ===\n\n";

# aliasing not really necessary, but more sexy.
*dms2s = *TrigCalc::dms_2_secs;

VECTOR:
for my $ar_vector (
    # only LEFT-most input args are converted.
    # expected   ------ input args ------
    #  seconds   secs mins degs   ignored
    [        0,                           ],  # empty args list
    [        1,    1                      ],
    [       62,    2,   1                 ],
    [     3723,    3,   2,   1            ],
    [     7384,    4,   3,   2,   4       ],
    [    11045,    5,   4,   3,   5, 6    ],
    [    14706,    6,   5,   4,   7, 8, 9 ],
    ) {

    if (not ref $ar_vector) {
        note $ar_vector;
        next VECTOR;
        }

    my ($expected, @args) = @$ar_vector;

    is dms2s(@args), $expected, "(@args) == $expected seconds";

    }  # end for VECTOR

done_testing;

exit;

# support subroutines ##############################################

# none for now
[download]

Update 1: Forgot to include the output of the script. Not really necessary, but I usually do so what the heck...
Output:

c:\@Work\Perl\monks\thechartist>perl TrigCalc.t
ok 1 - use TrigCalc;
# testing under perl version 5.008009
ok 2 - REALLY empty argument list
# --- degenerate cases ---
ok 3 - () -> (0, 0, 0): empty argument list
ok 4 - undef -> (0, 0, 0): undefined argument(s)
ok 5 - (undef, undef) -> (0, 0, 0): undefined argument(s)
ok 6 - (undef, undef, undef) -> (0, 0, 0): undefined argument(s)
# --- irreducible cases ---
ok 7 - (123, 180, 59, 59) -> (180, 59, 59): left ignored
ok 8 - (180, 59, 59) -> (180, 59, 59)
ok 9 - (180, 59, 58) -> (180, 59, 58)
ok 10 - (1, 1, 1) -> (1, 1, 1)
ok 11 - (0, 0, 0) -> (0, 0, 0)
ok 12 - (-1, -1, -1) -> (-1, -1, -1)
ok 13 - (-180, -59, -58) -> (-180, -59, -58)
ok 14 - (-123, -180, -59, -59) -> (-180, -59, -59): left ignored
# --- reducible cases ---
ok 15 - (179, 0, 60) -> (179, 1, 0)
ok 16 - (179, 61, 61) -> (180, 2, 1)
ok 17 - (179, 59, 60) -> (180, 0, 0)
ok 18 - (-179, 60, 0) -> (-178, 0, 0): reduction of negatives
ok 19 - (0, 0, -60) -> (0, -1, 0): negative borrow
ok 20 - (90, 360, 360) -> (96, 6, 0): multiple reduction
ok 21 - (90, -360, -360) -> (83, 54, 0): multiple reduction
# --- only rightmost arguments are reduced, others ignored ---
ok 22 - (200, 179, 0, 60) -> (179, 1, 0)
ok 23 - (200, 200, 179, 0, 60) -> (179, 1, 0)
ok 24 - (200, 200, 200, 179, 0, 60) -> (179, 1, 0)
ok 25 - (200, 90, -360, -360) -> (83, 54, 0)
ok 26 - (200, 200, 90, -360, -360) -> (83, 54, 0)
ok 27 - (200, 200, 200, 90, -360, -360) -> (83, 54, 0)
#
# === testing TrigCalc::dms_2_secs() ===
#
ok 28 - () == 0 seconds
ok 29 - (1) == 1 seconds
ok 30 - (2 1) == 62 seconds
ok 31 - (3 2 1) == 3723 seconds
ok 32 - (4 3 2 4) == 7384 seconds
ok 33 - (5 4 3 5 6) == 11045 seconds
ok 34 - (6 5 4 7 8 9) == 14706 seconds
1..34
ok 35 - no warnings
1..35
[download]

Update 2: Here's a version of reduce() with all component behaviors folded into the function. It handles incomplete argument lists better IMHO, also handles undef-s more gracefully. Fully tested.

sub reduce {

    # reduce from rightmost end of argument list.
    # left-pad input arguments with 0s to avoid inaccessible items.

    my ($degs,  # degrees
        $mins,  # minutes
        $secs,  # seconds
        ) = map $_ || 0, (0, 0, 0, @_)[ -3 .. -1 ];  # handles undefs

    use integer;

    $secs = $degs * SECS_PER_DEGREE + $mins * SECS_PER_MINUTE + $secs;

    $degs = $secs / SECS_PER_DEGREE;   $secs %= SECS_PER_DEGREE;
    $mins = $secs / SECS_PER_MINUTE;   $secs %= SECS_PER_MINUTE;

    return $degs, $mins, $secs;

    }
[download]

(If you have Perl version 5.10+, the || operator in the $_ || 0 map expression can be changed to the // defined-or operator.)

Give a man a fish: <%-{-{-{-<

In reply to Re^3: How to write testable command line script? (updated) by AnomalousMonk
in thread How to write testable command line script? by thechartist

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


laziness, impatience, and hubris
	PerlMonks