package Rectangle;
use Moo;

has height => (is => 'rw');
has width  => (is => 'rw');

sub demo {
    my ($self) = @_;

    printf "Demo of %s\n", ref $self;
    $self->show_dimensions;
    printf "Resetting height => 4, width => 3\n";
    $self->height(4);
    $self->width(3);

    $self->show_dimensions;
    printf "area: %d\n", $self->area;
    $self->show_dimensions;
}

sub area {
    my ($self) = @_;
    $self->{width} * $self->{height};
}

sub show_dimensions {
    my ($self) = @_;

    printf "height: %s, width: %s\n", $self->{height} || 'undef', $sel
+f->{width} || '';
}

package Square;
use Moo;

extends 'Rectangle';

sub area {
    my ($self) = @_;
    $self->{height} = $self->{width};
    $self->SUPER::area();
}

package main;

my $rect = Rectangle->new(width => 2, height => 2);
my $sq = Square->new(width => 2);

$rect->demo;
print "\n";
$sq->demo;
[download]

Demo of Rectangle
height: 2, width: 2
Resetting height => 4, width => 3
height: 4, width: 3
area: 12
height: 4, width: 3

Demo of Square
height: undef, width: 2
Resetting height => 4, width => 3
height: 4, width: 3
area: 9
height: 3, width: 3
[download]

A rectangle class might have horizontal_stretch and vertical_stretch methods which stretch a rectangle in one direction. Square is a subclass of rectangle, but if you stretch a square in one direction, it's no longer a square.

Generalising the issue: mutator methods in the parent class might invalidate constraints imposed by the child class.

The square—rectangle problem (a.k.a. the circle—ellipse problem) is often seen as a demonstration of why subclassing is evil. I prefer to see it as a demonstration of why mutable objects are evil.

Here's a perfectly consistent implementation of a Square and Rectangle class using immutable objects and subclassing...

use Moops;

class Rectangle using Moose :ro {
    has height => (isa => Num, required => true);
    has width  => (isa => Num, required => true);
    has colour => (isa => Str, default => "black");
    
    method area () {
        $self->height * $self->width;
    }
    
    method perimeter () {
        2 * ($self->height + $self->width);
    }
    
    # Here's a private method; it creates a clone of
    # the current object, but allows some attributes to
    # be changed.
    #
    method my $_but (%args) {
        __PACKAGE__->new(%$self, %args);
    }
    
    method paint (Str $colour) {
        $self->$_but( colour => $colour );
    }
    
    method horizontal_stretch (Num $factor) {
        my $new_width = $self->width * $factor;
        $self->$_but( width => $new_width );
    }
    
    method vertical_stretch (Num $factor) {
        my $new_height = $self->height * $factor;
        $self->$_but( height => $new_height );
    }
    
    method grow (Num $factor) {
        $self->horizontal_stretch($factor)->vertical_stretch($factor);
    }    
}

class Square extends Rectangle using Moose :ro {
    around BUILDARGS (@args) {
        my $params = $self->$next(@args);
        $params->{height} //= $params->{width};
        $params->{width}  //= $params->{height};
        return $params;
    }
    method BUILD {
        confess "Not a square" unless $self->width == $self->height;
    }
}

my $square = Square->new(width => 12);
print $square->dump;

my $painted = $square->paint("red");
print $painted->dump;

my $grown = $painted->vertical_stretch(2.5);
print $grown->dump;
[download]

toby döt ink
/a