propagate normal form when it is changed on a lemma reading. #38

diff --git a/morphology/lib/Text/Tradition/Morphology.pm b/morphology/lib/Text/Tradition/Morphology.pm
index ab3017b..31a49ef 100644 (file)
--- a/morphology/lib/Text/Tradition/Morphology.pm
+++ b/morphology/lib/Text/Tradition/Morphology.pm
@@ -70,19 +70,23 @@ has 'reading_lexemes' => (
        
 
 
-# Make normal_form default to text, transparently.
+# Make normal_form default to text, transparently; also propagate the
+# normal form given if the reading is a lemma.
 around 'normal_form' => sub {
        my $orig = shift;
        my $self = shift;
-       my( $arg ) = @_;
+       unless( @_ ) {
+               # return the right default
+               return $self->_has_normal_form ? $self->$orig() : $self->text;
+       }
+       my $arg = shift;
        if( $arg && $arg eq $self->text ) {
                $self->_clear_normal_form;
-               return $arg;
-       } elsif( !$arg && !$self->_has_normal_form ) {
-               return $self->text;
        } else {
-               $self->$orig( @_ );
+               $self->$orig( $arg );
        }
+       $self->push_normal_form() if $self->is_lemma;
+       return $arg;
 };
 
 =head1 READING METHODS
@@ -287,6 +291,17 @@ $r3->make_lemma( 1 );
 is( $r4->normal_form, 'YAN', "normal form propagated" );
 is( $r5->normal_form, 'YAN', "normal form propagated" );
 
+# Now try modifying the normal form and making sure the change is propagated
+$r3->normal_form( 'JIGGIT' );
+is( $r4->normal_form, 'JIGGIT', "new normal form propagated" );
+is( $r5->normal_form, 'JIGGIT', "new normal form propagated" );
+
+# ...and that no change is propagated if the reading isn't a lemma.
+$r4->normal_form( 'JOLLY' );
+is( $r3->normal_form, 'JIGGIT', "normal form on non-lemma not propagated" );
+is( $r5->normal_form, 'JIGGIT', "normal form on non-lemma not propagated" );
+
+
 # Finally, try a relationship that shouldn't propagate the normal form
 my $r6 = $c->reading('w91');
 my $r7 = $c->reading('w92');

diff --git a/morphology/t/text_tradition_morphology.t b/morphology/t/text_tradition_morphology.t
index c78772e..db7483f 100644 (file)
--- a/morphology/t/text_tradition_morphology.t
+++ b/morphology/t/text_tradition_morphology.t
@@ -49,6 +49,17 @@ $r3->make_lemma( 1 );
 is( $r4->normal_form, 'YAN', "normal form propagated" );
 is( $r5->normal_form, 'YAN', "normal form propagated" );
 
+# Now try modifying the normal form and making sure the change is propagated
+$r3->normal_form( 'JIGGIT' );
+is( $r4->normal_form, 'JIGGIT', "new normal form propagated" );
+is( $r5->normal_form, 'JIGGIT', "new normal form propagated" );
+
+# ...and that no change is propagated if the reading isn't a lemma.
+$r4->normal_form( 'JOLLY' );
+is( $r3->normal_form, 'JIGGIT', "normal form on non-lemma not propagated" );
+is( $r5->normal_form, 'JIGGIT', "normal form on non-lemma not propagated" );
+
+
 # Finally, try a relationship that shouldn't propagate the normal form
 my $r6 = $c->reading('w91');
 my $r7 = $c->reading('w92');