package CheckContext;

use strict;
use warnings;

use Attribute::Handlers;

sub VOID : ATTR(CODE) {
    my ($pkg,$sym,$code) = @_;
    
    my $name = *{$sym}{NAME};
    no warnings 'redefine';
    
    *{ $sym } = sub {
        my $context = wantarray;
        if( defined $context ) {
            die "sub have to be called in void context";
        }

        $code->( @_ );
    }
}

sub SCALAR : ATTR(CODE) {
    my ($pkg,$sym,$code) = @_;
    
    my $name = *{$sym}{NAME};
    no warnings 'redefine';
    
    *{ $sym } = sub {
        my $context = wantarray;
        unless( defined $context and not $context ) {
            die "sub have to be called in scalar context";
        }

        $code->( @_ );
    }
}

sub LIST : ATTR(CODE) {
    my ($pkg,$sym,$code) = @_;
    
    my $name = *{$sym}{NAME};
    no warnings 'redefine';
    
    *{ $sym } = sub {
        my $context = wantarray;
        unless( defined $context and $context ) {
            die "sub have to be called in list context";
        }

        $code->( @_ );
    }
}

1;