view release on metacpan or  search on metacpan

t/99-performance-regression.t  view on Meta::CPAN

package main;

my $ITERATIONS = 100000;
my $ROLE_ITERATIONS = 50000;

# Store individual timing results
my %timing_results;

sub run_highres_benchmark {
    my ($code, $iterations) = @_;
    $iterations ||= $ITERATIONS;

    # Warm up
    $code->() for 1..1000;

    my $start = time();
    $code->() for 1..$iterations;
    my $end = time();

    return $end - $start;
}

sub run_benchmarks {
    my %results;

    # Basic Object Creation
    diag "\n=== Benchmarking Basic Object Creation ($ITERATIONS iterations) ===";

    $timing_results{class_create} = run_highres_benchmark(sub {
        Test::Performance::Class->new(name => 'test');
    });

    $timing_results{class_more_create} = run_highres_benchmark(sub {
        Test::Performance::ClassMore->new(name => 'test');
    });

    diag sprintf "  Class:      %.4f seconds", $timing_results{class_create};
    diag sprintf "  Class::More: %.4f seconds", $timing_results{class_more_create};

    # Method Access
    diag "\n=== Benchmarking Method Access ($ITERATIONS iterations) ===";
    my $class_obj = Test::Performance::Class->new;
    my $class_more_obj = Test::Performance::ClassMore->new;

    $timing_results{class_access} = run_highres_benchmark(sub {
        $class_obj->custom_method;
    });

    $timing_results{class_more_access} = run_highres_benchmark(sub {
        $class_more_obj->custom_method;
    });

    diag sprintf "  Class:      %.4f seconds", $timing_results{class_access};
    diag sprintf "  Class::More: %.4f seconds", $timing_results{class_more_access};

    # Role Composition Performance - Same Role with different classes
    diag "\n=== Benchmarking Role Composition ($ROLE_ITERATIONS iterations) ===";

    $timing_results{class_with_role} = run_highres_benchmark(sub {
        Test::Performance::ClassWithRole->new(name => 'test');
    }, $ROLE_ITERATIONS);

    $timing_results{class_more_with_role} = run_highres_benchmark(sub {
        Test::Performance::ClassMoreWithRole->new(name => 'test');
    }, $ROLE_ITERATIONS);

    diag sprintf "  Class + Role:      %.4f seconds", $timing_results{class_with_role};
    diag sprintf "  Class::More + Role: %.4f seconds", $timing_results{class_more_with_role};

    # Role Method Access
    diag "\n=== Benchmarking Role Method Access ($ITERATIONS iterations) ===";
    my $class_role_obj = Test::Performance::ClassWithRole->new(name => 'test');
    my $class_more_role_obj = Test::Performance::ClassMoreWithRole->new(name => 'test');

    $timing_results{class_role_method} = run_highres_benchmark(sub {
        $class_role_obj->role_method;
    });

    $timing_results{class_more_role_method} = run_highres_benchmark(sub {
        $class_more_role_obj->role_method;
    });

    diag sprintf "  Class + Role method:      %.4f seconds", $timing_results{class_role_method};
    diag sprintf "  Class::More + Role method: %.4f seconds", $timing_results{class_more_role_method};

    # Multiple Role Composition
    diag "\n=== Benchmarking Multiple Role Composition (".($ROLE_ITERATIONS/2)." iterations) ===";

    $timing_results{class_multi_role} = run_highres_benchmark(sub {
        Test::Performance::ClassWithMultipleRoles->new;
    }, $ROLE_ITERATIONS/2);

    $timing_results{class_more_multi_role} = run_highres_benchmark(sub {
        Test::Performance::ClassMoreWithMultipleRoles->new;
    }, $ROLE_ITERATIONS/2);

    diag sprintf "  Class + 3 Roles:      %.4f seconds", $timing_results{class_multi_role};
    diag sprintf "  Class::More + 3 Roles: %.4f seconds", $timing_results{class_more_multi_role};

    # Inheritance Performance
    diag "\n=== Benchmarking Inheritance ($ITERATIONS iterations) ===";

    $timing_results{class_inherit} = run_highres_benchmark(sub {
        Test::Performance::ClassChild->new(name => 'test');
    });

    $timing_results{class_more_inherit} = run_highres_benchmark(sub {
        Test::Performance::ClassMoreChild->new(name => 'test');
    });

    diag sprintf "  Class inheritance:      %.4f seconds", $timing_results{class_inherit};