Pragmatic
Contract Programming

in Perl

erwan@cpan.org
Nordic Perl Workshop 2008
YAPC::EU 2008

$Revision: 1.3 $

Menu

Real Life Problems

Perl 5

Problem 1: API change

# hash-style arg passing
sub foo {
    my (%args) = @_;
    my $fund = $args{fund} || $default;
    ...
}

...

foo(fund => $bla);

Problem 1: API change

# key fund replaced by to_fund
sub foo {
    my (%args) = @_;
    my $fund = $args{to_fund} || $default;
    ...
}

...

# and we forget to change here
foo(fund => $bla);

NO ERROR!!

Problem 2: Emerging types

Problem 2: Emerging types

# a fund is a 6 digit integer...

sub foo {
    confess "not a fund" if ($fund !~ /^[0-9]+$/);
}

sub bar {
    confess "not a fund" if ($fund !~ /^[0-9]{6}$/);
}

sub beer {
    confess "not a fund" if ($fund !~ /\d\d\d\d\d\d/);
}

one day the type changes, a fund becomes 8 digits, and half of the regexps fail...

Problem 3: Argument validation

Mature code checks subroutine arguments heavily:

sub foo {
    my (%args) = @_;
    my $fund = delete $args{to_fund};

    confess "unexpected args" if (keys %args);
    confess "to_fund undefined" if (!defined $fund);
    confess "to_fund is not a scalar" if (ref $fund ne "");
    confess "not a valid fund" if (!is_fund $fund);

	...
}

Problem 3: Argument validation

Problem 4: context!

# key fund replaced by to_fund
sub foo {
    return (1,2,3);
}

# but you misread the (unexisting?) api documentation
# for foo() and believe it returns a scalar:

my $a = foo();

It runs but it's a bug.

So What?

Programming by Contract

The Contract Paradigm

Wikipedia says:

The central idea of DbC is a metaphor on how elements of a software system collaborate with each other, on the basis of mutual obligations and benefits

Common features

Within DBC, every class/object/method/function must validate some:

Contracts even define failure strategies.

Unclear issues

Contract implementations are limited with respect to:

Consequences

Consequences

Example in Eiffel (function)

put (x: ELEMENT; key: STRING) is
    require
        count <= capacity
        not key.empty
    do
        ... Some insertion algorithm ...
    ensure
        has (x)
        item (key) = x
        count = old count + 1
    end

Example in Java (with iContract)

/**
 * @pre f >= 0.0
 * @post Math.abs((return * return) - f) < 0.001
 */

public float sqrt(float f) { ... }

Example in Perl: Class::Agreement

package SomeClass;

use Class::Agreement;

invariant {
    my ($self) = @_;
    $self->count > 0;
};

precondition add => sub {
    my ( $self, $value ) = @_;
    return ( $value >= 0 );
};

sub add { ... }

Example in Perl: Class::Contract

package ClassName
use Class::Contract;

contract {
    inherits 'BaseClass';

    invar { ... };

    method 'methodname';
        pre  { ... };
            failmsg 'Error message';

        post  { ... };
            failmsg 'Error message';

        impl { ... };

    # etc.
};

huh... Still with me?

Remember our problems?

Solutions in Perl

Keep it real - Be Pragmatic

We want:

Introducing... Sub::Contract!

Sub::Contract

Sub::Contract (list style)

use Sub::Contract qw(contract);

# constraints are closures that return true or false

contract('incr')
    ->in( sub { return defined $_[0] && $_[0] =~ /^\d+$/; } )
    ->enable;

sub incr {
    my $a = shift;
    return $a+1;
}

Sub::Contract (list style)

use Sub::Contract qw(contract);

sub is_integer {
    return defined $_[0] && $_[0] =~ /^\d+$/;
}

contract('incr')
    ->in(\&is_integer)
    ->out(\&is_integer)
    ->enable;

sub incr {
    my $a = shift;
    return $a+1;
}

Sub::Contract (list style)

use Sub::Contract qw(contract);

contract('incr')
    ->in(\&is_integer)
    ->out(\&is_integer)
    ->enable;

# incr(1)       -> ok
# incr("abc")   -> fail
# incr()        -> fail
# incr(1,2)     -> fail
# incr(1,undef) -> fail
# incr([])      -> fail

Defining a constraint library

Defining a constraint library

package My::Constraints;

sub is_integer {
    my $val = shift;
    return 0 if (!defined $val);
    return 0 if (ref $val ne "");
    return ($val =~ /^\d+$/) ? 1:0;
}

sub is_longdate {...}
sub is_shortdate {...}
sub is_red_circle {...}
sub is_loaned_booked {...}
...

Sub::Contract (list style)

use Sub::Contract qw(contract);
use My::Constraints;

contract('add')
    ->in( \&is_integer, undef, \&is_integer )
    ->out( \&is_integer )
    ->enable;

sub add {
    my ($a,$b,$c) = @_;
    $b = 1 if (!defined $b);
    return $a+$b+$c;
}

# add(1,undef,3) -> ok
# add(1,-6,3) -> fail

Sub::Contract (hash style)

use Sub::Contract qw(contract);
use My::Constraints;

contract('add')
    ->in( a => \&is_integer,
          b => \&is_integer,
          c => \&is_integer )->enable;

sub add {
    my (%args) = @_;
    return $args{a}+$args{b}+$args{c};
}

# add(a => 1, b => 2, c => 3)         -> ok
# add(a => 1, b => 2)                 -> fail
# add(a => 1, b => 2, c => undef)     -> fail
# add(a => 1, b => 2, c => 3, d => 4) -> fail

Sub::Contract (mixed style)

use Sub::Contract qw(contract);
use My::Constraints;

contract('add')
    ->in( \&is_integer,
          \&is_integer,
          c => \&is_integer )
    ->enable;

sub add {
    my ($a,$b,%args) = @_;
    return $a+$b+$args{c};
}

# add(1,2,c => 3)       -> ok
# add(1,2,d => 3)       -> fail
# add(1,undef, c => 3)  -> fail

Sub::Contract (oo-style)

use Sub::Contract qw(contract is_a);

contract('foo')
    ->in( is_a("MyModule"),
          c => \&is_integer )
    ->enable;

sub foo {}

# $object->foo(c => 123)    -> ok
# $object->foo()            -> fail

Sub::Contract (memoizing)

use My::Constraints;
use Sub::Contract qw(contract);

# to_shortdate("2006-02-30 00:00:00") = "2006-02-30"
sub to_shortdate {
    return substr($_[0],0,10);
}

contract('to_shortdate')
    ->in(\&is_longdate)
    ->out(\&is_shortdate)
    ->cache
    ->enable;

Manipulating contracts at runtime

use Sub::Contract::Pool qw(get_contract_pool);

my $pool = get_contract_pool;

$pool->disable_all_contracts;

# do some time-critical stuff

$pool->enable_all_contracts;

Manipulating contracts at runtime

use Sub::Contract::Pool qw(get_contract_pool);

# disable all contracts contracting
# subroutines under My::Module::*

my $pool = get_contract_pool;
my @c = $pool->find_contracts_matching("^My::Module::");

foreach my $contract (@c) {
    $contract->disable;
}

Generating contracts at runtime

# generate new contracts at runtime for unknown modules

use Module::Pluggable search_path => [$path], require => 1;

foreach my $module (__PACKAGE__->plugins()) {
    new Sub::Contract($module."::some_method")
        ->in(\&test1,\&test2)
        ->enable;
}

Higher order constraints

use Sub::Contract qw( contract
                      is_a
                      defined_and
                      undef_or );

contract('intersect')
    ->in(is_a("My::Line"),
         c => defined_and(is_a("My::Circle")),
         pos => undef_or(\&is_integer))
    ->enable;

# ex:
# $line->intersect(c => $circle, pos => 12);

What's next?

Questions?

Thank you!