#!/usr/bin/perl

package Test;

use base qw(Tk::Derived Tk::Frame);
use Tk::widgets qw(Canvas);
Construct Tk::Widget 'Test';

use strict;
use warnings 'all';

sub Populate
{
    my($frame, $args) = @_;

    $args->{-background} = 'black' unless defined $args->{-background};
    # create Frame
    $frame->SUPER::Populate($args);

    # create Canvas
    my $canvas = $frame->Component(Canvas => 'canvas',)->pack();

    # delegates and configspecs
    $frame->Delegates  (DEFAULT => $frame);
    $frame->ConfigSpecs(DEFAULT => [$canvas]);

    return $frame;
} # Populate

package main;

use strict;
use warnings 'all';
use Tk;

my $mw   = tkinit();
my $test = $mw->Test()->pack();

MainLoop;