#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use Object::Proto;

# Test Role support (zero overhead)

# Define a role with slots
Object::Proto::role('Serializable',
    'format:Str:default("json")',
);

# Add a method to the role
package Serializable;
sub serialize { 
    my ($self) = @_;
    return "serialized:" . $self->format; 
}
package main;

# Define a class
Object::Proto::define('Document',
    'title:Str:required',
    'content:Str',
);

# Apply the role
Object::Proto::with('Document', 'Serializable');

# Test 1: Class has role's slots
my $doc = Document->new(title => "Test");
ok($doc->can('format'), 'Document has format accessor from role');
is($doc->format, 'json', 'Default value from role slot works');

# Test 2: Class has role's methods
ok($doc->can('serialize'), 'Document has serialize method from role');
is($doc->serialize, 'serialized:json', 'Role method works');

# Test 3: Object::Proto::does check
ok(Object::Proto::does($doc, 'Serializable'), 'Object does Serializable');
ok(Object::Proto::does('Document', 'Serializable'), 'Class does Serializable');
ok(!Object::Proto::does($doc, 'NonExistent'), 'Object does not do NonExistent');

# Test 4: Role with required methods
Object::Proto::role('Printable');
Object::Proto::requires('Printable', 'to_string');

# Define class with required method
package PrintableDoc;
sub to_string { 
    my ($self) = @_;
    return $self->title; 
}
package main;

Object::Proto::define('PrintableDoc', 'title:Str');
eval { Object::Proto::with('PrintableDoc', 'Printable') };
ok(!$@, 'Class with required method consumes role OK');

# Test 5: Role without required method fails
Object::Proto::define('BadDoc', 'title:Str');
eval { Object::Proto::with('BadDoc', 'Printable') };
ok($@, 'Class without required method fails');
like($@, qr/does not implement required method 'to_string'/, 'Error mentions missing method');

# Test 6: Multiple roles
Object::Proto::role('Timestamped',
    'created_at:Str',
    'updated_at:Str',
);

Object::Proto::define('Article',
    'title:Str:required',
);
Object::Proto::with('Article', 'Serializable', 'Timestamped');

my $article = Article->new(title => "News");
ok($article->can('format'), 'Article has Serializable slot');
ok($article->can('created_at'), 'Article has Timestamped slot');
ok(Object::Proto::does($article, 'Serializable'), 'Article does Serializable');
ok(Object::Proto::does($article, 'Timestamped'), 'Article does Timestamped');

# Test 7: Slot conflict detection
Object::Proto::role('Conflicting',
    'title:Str',  # Same as Article's slot
);

eval { Object::Proto::with('Article', 'Conflicting') };
ok($@, 'Slot conflict detected');
like($@, qr/Slot conflict.*'title'/, 'Error mentions conflicting slot');

# Test 8: Eager builder on role slot can be implemented by consuming class
Object::Proto::role('BuildableRole',
    'payload:Str:builder()'
);

package BuildableConsumer;
our $buildable_consumer_count = 0;
sub _build_payload {
    $buildable_consumer_count++;
    return 'consumer payload';
}
package main;

Object::Proto::define('BuildableConsumer');
Object::Proto::with('BuildableConsumer', 'BuildableRole');

$BuildableConsumer::buildable_consumer_count = 0;
my $buildable = BuildableConsumer->new();
is($BuildableConsumer::buildable_consumer_count, 1,
   'Role eager builder called during consuming class construction');
is($buildable->payload, 'consumer payload',
   'Role slot builder value comes from consuming class');

# Test 9: Same role builder remains overridable in subclasses
Object::Proto::define('BuildableChild',
    extends => 'BuildableConsumer',
);

package BuildableChild;
our $buildable_child_count = 0;
sub _build_payload {
    $buildable_child_count++;
    return 'child payload';
}
package main;

$BuildableChild::buildable_child_count = 0;
my $buildable_child = BuildableChild->new();
is($BuildableChild::buildable_child_count, 1,
   'Subclass can supply builder for inherited role slot');
is($buildable_child->payload, 'child payload',
   'Inherited role slot builder resolves in subclass');

done_testing();
