Pragmatic
Contract Programming

in Perl

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

$Revision: 1.3 $

Menu

• Real life problems with Perl
• The contract paradigm
• Examples
• Sub::Contract

Real Life Problems

Perl 5

• Perl5 is a weakly typed language
• Type binding is dynamic: a variable can be anything at any time
• Little support for subroutine signatures:

sub foo ($$) {
    my ($a,$b) = @_;
}

foo(1,[3]);  # no error

• This leads to a number of programming problems...

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

• a variable type arises as software grows
• but we miss to identify it as a type
• symptom: regexp mutation

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

• LOTS OF possibilities to check for
• Monkey code
• Redundant code from sub to sub
• Overhead equals confusion
• Confusion causes failure: BAD

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?

• We want a mechanism to abstract away runtime argument validation in subroutines with minimal syntax overhead
• Perl6 will have constraints
• But what of Perl5?

Programming by Contract

The Contract Paradigm

• It is a paradigm: a set of problems and technics, no unique definition
• Introduced in Eiffel in 1986
• Implemented in many languages
• Programming by Contract versus Design by contract (DBC)

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

• elements = objects/classes
• collaborate = call methods/functions

Common features

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

• preconditions (what is expected)
• postconditions (what is guaranted)
• invariants (what is maintained)

Contracts even define failure strategies.

Unclear issues

Contract implementations are limited with respect to:

• relevant error messages
• inheritance

Consequences

• argument and result validation is implemented in the contract, not in the function body
• contracts can be used to auto-generate:
• specifications
• API documentations
• regression tests

Consequences

• tests can focus on function bodies and skip argument/result validation code
• less and more relevant code in function bodies: GOOD++

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?

• API validation
• emerging types
• argument/result validation
• context checking

Solutions in Perl

• Class::Agreement
• Class::Contract
• Too overkill. Bleh. We don't need:
• invariants, pre, post conditions
• contract inheritance
• design by contract
• a new package syntax

Keep it real - Be Pragmatic

We want:

• Argument/result validation
• Simple syntax
• Dynamic contracts
• Easy memoizing

Introducing... Sub::Contract!

Sub::Contract

• One contract per subroutine
• A contract sets constraints on input/return arguments
• It can memoize results
• A contract is dynamic

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

• May sound like an obstacle...
• ... but you end up doing it whether or not you use contracts.

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?

• Contract contexts
• Speed++

Questions?

Thank you!