From 9cbd30c3d8d77a7e87edce41d75292f0dc654992 Mon Sep 17 00:00:00 2001
From: Patrick Donelan <pat@patspam.com>
Date: Sun, 17 May 2009 08:15:59 +0000
Subject: [PATCH] Refactored Survey test suite diagnostics etc..

---
 .../Asset/Wobject/Survey/ExpressionEngine.pm  |  13 ++
 lib/WebGUI/Asset/Wobject/Survey/Test.pm       | 211 +++++++++++++++---
 t/Asset/Wobject/Survey/ExpressionEngine.t     |   3 +-
 t/Asset/Wobject/Survey/Test.t                 | 206 +++++++++++++----
 4 files changed, 355 insertions(+), 78 deletions(-)

diff --git a/lib/WebGUI/Asset/Wobject/Survey/ExpressionEngine.pm b/lib/WebGUI/Asset/Wobject/Survey/ExpressionEngine.pm
index c947e2a94..113fca9ec 100644
--- a/lib/WebGUI/Asset/Wobject/Survey/ExpressionEngine.pm
+++ b/lib/WebGUI/Asset/Wobject/Survey/ExpressionEngine.pm
@@ -349,6 +349,18 @@ sub avg {
     return sum(@vals) / @vals;
 }
 
+=head2 round
+
+Utility sub shared with Safe compartment to allows expressions to easily round numbers
+
+=cut
+
+sub round {
+    my ($number, $precision) = @_;
+    $precision ||= 0;
+    return sprintf("%.${precision}f", $number);
+}
+
 =head2 run ( $session, $expression, $opts )
 
 Class method.
@@ -451,6 +463,7 @@ sub run {
         $compartment->share('&exitUrl');
         $compartment->share('&restart');
         $compartment->share('&avg');
+        $compartment->share('&round');
 
         # Give them all of List::Util too
         $compartment->share_from( 'List::Util',
diff --git a/lib/WebGUI/Asset/Wobject/Survey/Test.pm b/lib/WebGUI/Asset/Wobject/Survey/Test.pm
index ca506134b..92283823e 100644
--- a/lib/WebGUI/Asset/Wobject/Survey/Test.pm
+++ b/lib/WebGUI/Asset/Wobject/Survey/Test.pm
@@ -148,6 +148,7 @@ sub run {
     for my $item (@$spec) {
         $self->_resetResponses($rJSON);
         $rJSON->lastResponse(-1);
+        my $name = $item->{name};
         if (my $args = $item->{test} ) {
             push @tap, $self->_test( { 
                 responseJSON => $rJSON, 
@@ -155,6 +156,7 @@ sub run {
                 surveyOrderIndexByVariableName => $surveyOrderIndexByVariableName,
                 args => $args,
                 testCount_ref => \$testCount,
+                name => $name,
             } );
         } 
         elsif (my $args = $item->{test_mc} ) {
@@ -164,6 +166,17 @@ sub run {
                 surveyOrderIndexByVariableName => $surveyOrderIndexByVariableName,
                 args => $args,
                 testCount_ref => \$testCount,
+                name => $name,
+            } );
+        } 
+        elsif (my $args = $item->{sequence} ) {
+            push @tap, $self->_sequence( { 
+                responseJSON => $rJSON, 
+                surveyOrder =>  $surveyOrder,
+                surveyOrderIndexByVariableName => $surveyOrderIndexByVariableName,
+                args => $args,
+                testCount_ref => \$testCount,
+                name => $name,
             } );
         } 
         else {
@@ -206,6 +219,7 @@ sub _test {
         surveyOrderIndexByVariableName => { type => HASHREF },
         testCount_ref => { type => SCALARREF },
         args => { type => HASHREF },
+        name => 0,
     });
     
     # assemble the top-level ingredients..
@@ -213,12 +227,14 @@ sub _test {
     my $surveyOrder = $opts{surveyOrder};
     my $surveyOrderIndexByVariableName = $opts{surveyOrderIndexByVariableName};
     my $args = $opts{args};
+    my $name = $opts{name};
     my $testCount = ++${$opts{testCount_ref}};
     
     # ..and the test-specific arguments
-    my ($next, $tags, $setup ) = @{$args}{qw(next tags setup)};
+    my ($next, $tagged, $score, $setup ) = @{$args}{qw(next tagged score setup)};
     delete $args->{next};
-    delete $args->{tags};
+    delete $args->{tagged};
+    delete $args->{score};
     delete $args->{setup};
     # n.b. everything left in %args assumed to be variable => answer_spec
     
@@ -255,7 +271,13 @@ sub _test {
         elsif ( $questionType eq 'Text' || $questionType eq 'Number' ) {
             # Assume spec is raw value to record in the single answer
             $responses->{"$address->[0]-$address->[1]-0"} = $spec;
-        } 
+        } elsif ( $questionType eq 'Year Month' ) {
+            if ($spec !~ m/\d{4} \w+/) {
+                return fail($testCount, "Invalid input for Year Month question type", "Got: $spec\nExpected: YYYY Month");
+            }
+            $self->session->log->debug("Recording Year Month value: $spec");
+            $responses->{"$address->[0]-$address->[1]-0"} = $spec;
+        }
         else {
             # Assume spec is the raw text of the answer we want
             my $answer;
@@ -282,10 +304,13 @@ sub _test {
     
     my $pageSection = $rJSON->survey->section($surveyOrder->[$lowestIndex]);
     my $pageQuestion = $rJSON->survey->question($surveyOrder->[$lowestIndex]);
-    my $what = "Page containing Section $pageSection->{variable}";
-    $what .= " Question $pageQuestion->{variable}" if $pageQuestion;
-    $what .= " jumps to $next" if $next;
-    $what .= " and tags data" if $tags;
+    if (!$name) {
+        $name = "Checking ";
+        my %what = ( next => $next, tagged => $tagged, score => $score );
+        $name .= join ' and ', (grep {$what{$_}} qw(next tagged score));
+        $name .= " on page containing Section $pageSection->{variable}";
+        $name .= " Question $pageQuestion->{variable}" if $pageQuestion;
+    }
     
     return $self->_recordResponses( { 
         responseJSON => $rJSON, 
@@ -293,9 +318,10 @@ sub _test {
         surveyOrder => $surveyOrder,
         surveyOrderIndexByVariableName => $surveyOrderIndexByVariableName, 
         next => $next,
-        tags => $tags,
+        tagged => $tagged,
+        score => $score,
         testCount => $testCount,
-        what => $what,
+        name => $name,
     });
 }
 
@@ -316,6 +342,7 @@ sub _test_mc {
         surveyOrderIndexByVariableName => { type => HASHREF },
         testCount_ref => { type => SCALARREF },
         args => { type => ARRAYREF },
+        name => 0,
     });
     
     # assemble the top-level ingredients..
@@ -348,9 +375,9 @@ sub _test_mc {
         my $responses = {};
         my $testCount = ++${$opts{testCount_ref}};
         
-        my ($next, $tags);
+        my ($next, $tagged, $score);
         if (ref $spec eq 'HASH') {
-            ($next, $tags) = @{$spec}{qw(next tags)};
+            ($next, $tagged, $score) = @{$spec}{qw(next tagged score)};
         } else {
             $next = $spec;
         }
@@ -359,10 +386,17 @@ sub _test_mc {
         my $answer = $answers->[$aIndex];
         my $recordedAnswer = $answer->{recordedAnswer};
         $responses->{$answerAddress} = $recordedAnswer;
-        
-        my $what = "$variable mc answer " . ($aIndex + 1);
-        $what .= " jumps to $next" if $next;
-        $what .= " and tags correct" if $tags;
+
+        my $name = $opts{name}; # get this fresh for every subtest
+        if ($name) {
+            # Add some extra diagnostic text since single test_mc generates multiple sub-tests
+            $name .= " mc answer "  . ($aIndex + 1);
+        } else {
+            $name = "Checking ";
+            my %what = ( next => $next, tagged => $tagged, score => $score );
+            $name .= join ' and ', (grep {$what{$_}} qw(next tagged score));
+            $name .= " for $variable mc answer " . ($aIndex + 1);
+        }
         
         $self->session->log->debug("Recording answer for mc question $variable at index $aIndex ($answerAddress) => $recordedAnswer");
         push @tap, $self->_recordResponses( { 
@@ -372,8 +406,9 @@ sub _test_mc {
             surveyOrderIndexByVariableName => $surveyOrderIndexByVariableName, 
             next => $next,
             testCount => $testCount,
-            what => $what,
-            tags => $tags,
+            name => $name,
+            tagged => $tagged,
+            score => $score,
         });
         
         $aIndex++;
@@ -381,6 +416,79 @@ sub _test_mc {
     return @tap;
 }
 
+=head2 _test
+
+Private sub. Triggered when a test spec requests "sequence".
+
+=cut
+
+sub _sequence {
+    my $self = shift;
+    my %opts = validate(@_, { 
+        responseJSON => { isa => 'WebGUI::Asset::Wobject::Survey::ResponseJSON' },
+        surveyOrder => { type => ARRAYREF },
+        surveyOrderIndexByVariableName => { type => HASHREF },
+        testCount_ref => { type => SCALARREF },
+        args => { type => HASHREF },
+        name => 0,
+    });
+    
+    # assemble the top-level ingredients..
+    my $rJSON = $opts{responseJSON};
+    my $surveyOrder = $opts{surveyOrder};
+    my $surveyOrderIndexByVariableName = $opts{surveyOrderIndexByVariableName};
+    my $args = $opts{args};
+    my $name = $opts{name};
+    my $testCount = ++${$opts{testCount_ref}};
+    
+    # n.b. everything in %args assumed to be variable => spec
+    
+    while ( my ( $variable, $spec ) = each %$args ) {
+        my $index = $surveyOrderIndexByVariableName->{$variable};
+        my $address = $surveyOrder->[$index];
+        my $question = $rJSON->survey->question($address);
+        my $questionType = $question->{questionType};
+        
+        # Iterate over all answers
+        my ($recordedAnswer, $score);
+        my $recordedAnswerDelta 
+            = $spec->{recordedAnswer} =~ m/desc/  ? -1 
+            : $spec->{recordedAnswer} =~ m/asc/   ?  1 
+            : $spec->{recordedAnswer} =~ m/cons/  ?  0
+            : undef;
+        
+        my $scoreDelta 
+            = $spec->{score} =~ m/desc/          ? -1 
+            : $spec->{score} =~ m/asc/           ?  1 
+            : $spec->{score} =~ m/cons/          ?  0
+            : undef;
+        
+        my $aNum = 0;
+        for my $a (@{$question->{answers}}) {
+            $aNum++;
+            
+            if (defined $recordedAnswerDelta && defined $recordedAnswer) {
+                my $expect = $recordedAnswer + $recordedAnswerDelta;
+                if ( $expect != $a->{recordedAnswer}) {
+                    return fail($testCount, "$variable answer index $aNum recordedAnswer not in sequence", "Got: $a->{recordedAnswer}\nExpected: $expect");
+                }
+            }
+            
+            if (defined $scoreDelta && defined $score) {
+                my $expect = $score + $scoreDelta;
+                if ( $expect != $a->{value}) {
+                    return fail($testCount, "$variable answer index $aNum score not in sequence",  "Got: $a->{value}\nExpected: $expect");
+                }
+            }
+            
+            $recordedAnswer = $a->{recordedAnswer};
+            $score = $a->{value};
+        }
+    }
+    
+    return pass($testCount, "Valid sequences");
+}
+
 =head2 _recordResponses
 
 Private sub. Records responses and checks that you end up where you expect
@@ -396,8 +504,9 @@ sub _recordResponses {
         surveyOrderIndexByVariableName => { type => HASHREF },
         next => 1,
         testCount => 1,
-        what => 0,
-        tags => 0,
+        name => 0,
+        tagged => 0,
+        score => 0,
     });
     
     # assemble the top-level ingredients..
@@ -407,8 +516,9 @@ sub _recordResponses {
     my $surveyOrderIndexByVariableName = $opts{surveyOrderIndexByVariableName};
     my $next = $opts{next};
     my $testCount = $opts{testCount};
-    my $what = $opts{what};
-    my $tags = $opts{tags};
+    my $name = $opts{name};
+    my $tagged = $opts{tagged};
+    my $score = $opts{score};
     
     $rJSON->recordResponses($responses);
 
@@ -431,30 +541,33 @@ sub _recordResponses {
     }
     my $expectedNextResponse = $surveyOrderIndexByVariableName->{$next};
     if ($nextResponse != $expectedNextResponse) {
-        return fail($testCount, $what, <<END_WHY);
+        return fail($testCount, $name, <<END_WHY);
 Compared next section/question
    got : $got
 expect : '$next'
 END_WHY
     }
-    # Check tags, if asked
-    if ($tags && ref $tags eq 'ARRAY') {
+    
+    # Check tagged, if asked
+    
+    # Since tags are often boolean flags, allow them to optionally be specified as an array
+    if ($tagged && ref $tagged eq 'ARRAY') {
         my $currentTags = $rJSON->tags;
-        for my $tag (@$tags) {
+        for my $tag (@$tagged) {
             my ($tagKey, $tagValue);
             if (ref $tag eq 'HASH') {
-                ($tagKey, $tagValue) = @$tag; # individual tag spec only has one key and one value
+                ($tagKey, $tagValue) = %$tag; # individual tag spec only has one key and one value
             } else {
                 ($tagKey, $tagValue) = ($tag, 1); # defaults to 1 (boolean truth flag)
             }
             if (!exists $currentTags->{$tagKey}) {
                  $self->session->log->debug("Tag not found: $tagKey");
-                return fail($testCount, $what, "Tag not found: $tagKey");
+                return fail($testCount, $name, "Tag not found: $tagKey");
             }
             my $currentTagValue = $currentTags->{$tagKey};
             if ($currentTagValue != $tagValue) {
                 $self->session->log->debug("Incorrect tag value: $currentTagValue != $tagValue");
-                return fail($testCount, $what, <<END_WHY);
+                return fail($testCount, $name, <<END_WHY);
 Compared tag '$tagKey'
    got : '$currentTagValue'
 expect : '$tagValue'
@@ -463,12 +576,44 @@ END_WHY
         }
     }
     
-    return pass($testCount, $what);
+    # Alternatively, tags can be a hash
+    if ($tagged && ref $tagged eq 'HASH') {
+        my $currentTags = $rJSON->tags;
+        while (my ($tagKey, $tagValue) = each %$tagged) {
+            my $currentTagValue = $currentTags->{$tagKey};
+            if ($currentTagValue != $tagValue) {
+                $self->session->log->debug("Incorrect tag value: $currentTagValue != $tagValue");
+                return fail($testCount, $name, <<END_WHY);
+Compared tag '$tagKey'
+   got : '$currentTagValue'
+expect : '$tagValue'
+END_WHY
+            }
+        }
+    }
+    
+    # Check score, if asked
+    if ($score && ref $score eq 'HASH') {
+        my $currentScores = $rJSON->responseScoresByVariableName;
+        while (my ($scoreKey, $scoreValue) = each %$score) {
+            my $currentScore = $currentScores->{$scoreKey};
+            if ($currentScore != $scoreValue) {
+                $self->session->log->debug("Incorrect score: $currentScore != $scoreValue");
+                return fail($testCount, $name, <<END_WHY);
+Compared score '$scoreKey'
+   got : '$currentScore'
+expect : '$scoreValue'
+END_WHY
+            }
+        }
+    }
+    
+    return pass($testCount, $name);
 }
 
 sub pass {
-    my ($testCount, $what, $extra) = @_;
-    my $out = $what ? "ok $testCount - $what" : "ok $testCount";
+    my ($testCount, $name, $extra) = @_;
+    my $out = $name ? "ok $testCount - $name" : "ok $testCount";
     if ($extra) {
         $extra =~ s/^/# /gm;
         $out .= "\n$extra";
@@ -477,8 +622,8 @@ sub pass {
 }
 
 sub fail {
-    my ($testCount, $what, $extra) = @_;
-    my $out = $what ? "not ok $testCount - $what" : "not ok $testCount";
+    my ($testCount, $name, $extra) = @_;
+    my $out = $name ? "not ok $testCount - $name" : "not ok $testCount";
     if ($extra) {
         chomp($extra);
         $extra =~ s/^/# /gm;
diff --git a/t/Asset/Wobject/Survey/ExpressionEngine.t b/t/Asset/Wobject/Survey/ExpressionEngine.t
index 2b5c603ae..3840fceea 100644
--- a/t/Asset/Wobject/Survey/ExpressionEngine.t
+++ b/t/Asset/Wobject/Survey/ExpressionEngine.t
@@ -22,7 +22,7 @@ my $session = WebGUI::Test->session;
 
 #----------------------------------------------------------------------------
 # Tests
-my $tests = 56;
+my $tests = 57;
 plan tests => $tests + 1;
 
 #----------------------------------------------------------------------------
@@ -71,6 +71,7 @@ SKIP: {
         q{jump { if (value(n) == 5) { 1 } else { 0 } } target},                # if statement
         q{jump { $q2 = 3; $avg = (value(n) + $q2) / 2; $avg == 4 } target},    # look ma, averages!
         q{jump { $q2 = 3; avg(value(n), $q2) == 4 } target},                   # look ma, built-in avg sub!
+        q{jump { round(3.456) == 3 && round(3.456, 2) == 3.46 } target},       # rounding
         q{jump { value(n) == 5 } target; jump { value(n) == 5 } targetX},      # first jump wins
         q{jump { value(n) == 0 } targetX; jump { value(n) == 5 } target},      # false jumps ignored
         q{jump { min(3,5,2) == 2 } target},                                    # List::Util min
diff --git a/t/Asset/Wobject/Survey/Test.t b/t/Asset/Wobject/Survey/Test.t
index 1ee76e264..e6cc581cb 100644
--- a/t/Asset/Wobject/Survey/Test.t
+++ b/t/Asset/Wobject/Survey/Test.t
@@ -21,7 +21,7 @@ my $session = WebGUI::Test->session;
 
 #----------------------------------------------------------------------------
 # Tests
-plan tests => 34;
+plan tests => 52;
 
 my ( $s, $t1 );
 
@@ -46,13 +46,12 @@ $s->surveyJSON_newObject( [] ); # S1
 $s->surveyJSON_newObject( [] ); # S2
 $s->surveyJSON_newObject( [] ); # S3
 $s->surveyJSON_newObject( [] ); # S4
+$s->surveyJSON_newObject( [] ); # S5
 
 # Name the sections
-$s->surveyJSON_update( [0], { variable => 'S0' } );
-$s->surveyJSON_update( [1], { variable => 'S1' } );
-$s->surveyJSON_update( [2], { variable => 'S2' } );
-$s->surveyJSON_update( [3], { variable => 'S3' } );
-$s->surveyJSON_update( [4], { variable => 'S4' } );
+for my $sIndex (0..5) {
+    $s->surveyJSON_update( [$sIndex], { variable => "S$sIndex" } );
+}
 
 # ..and now some questions
 $s->surveyJSON_newObject( [0] ); # S0Q0
@@ -60,8 +59,8 @@ $s->surveyJSON_newObject( [1] ); # S1Q0
 $s->surveyJSON_newObject( [2] ); # S2Q0
 $s->surveyJSON_newObject( [3] ); # S3Q0
 $s->surveyJSON_newObject( [3] ); # S3Q1
+$s->surveyJSON_newObject( [3] ); # S3Q2
 $s->surveyJSON_newObject( [4] ); # S4Q0
-$s->surveyJSON_newObject( [4] ); # S4Q1
 
 # Name the questions
 $s->surveyJSON_update( [ 0, 0 ], { variable => 'S0Q0' } );
@@ -69,16 +68,24 @@ $s->surveyJSON_update( [ 1, 0 ], { variable => 'S1Q0' } );
 $s->surveyJSON_update( [ 2, 0 ], { variable => 'S2Q0' } );
 $s->surveyJSON_update( [ 3, 0 ], { variable => 'S3Q0' } );
 $s->surveyJSON_update( [ 3, 1 ], { variable => 'S3Q1' } );
+$s->surveyJSON_update( [ 3, 2 ], { variable => 'S3Q2' } );
 $s->surveyJSON_update( [ 4, 0 ], { variable => 'S4Q0' } );
-$s->surveyJSON_update( [ 4, 1 ], { variable => 'S4Q1' } );
 
 # Set additional options..
 $s->surveyJSON_update( [ 0, 0 ], { questionType => 'Yes/No' } ); # S0Q0 is a Yes/No
-$s->surveyJSON_update( [ 0, 0 ], { gotoExpression => q{ tag('tagged at S0Q0'); } } ); # S0Q0 tags data
+$s->surveyJSON_update( [ 0, 0 ], { gotoExpression => q{ tag('tagged at S0Q0'); } } ); # S0Q0 tagged data
 
 $s->surveyJSON_update( [ 1, 0 ], { questionType => 'Yes/No' } ); # S1Q0 is a Yes/No
 $s->surveyJSON_update( [ 1, 0, 0 ], { goto => 'S3' } ); # S1Q0 answer 0 jumps to S3
-$s->surveyJSON_update( [ 1, 0, 1 ], { gotoExpression => q{ tag('tagged at S1Q0'); } } );# S1Q0 answer 1 tags data
+$s->surveyJSON_update( [ 1, 0, 1 ], { gotoExpression => q{ tag('tagged at S1Q0', 999); } } );# S1Q0 answer 1 tagged numeric data
+
+$s->surveyJSON_update( [ 3 ], { gotoExpression => q{ jump { score(S3) == 0 } S5; } } ); # jump to S5 if all 3 questions answered as No
+for my $qIndex (0..2) {
+    $s->surveyJSON_update( [ 3, $qIndex ], { questionType => 'Yes/No', required => 1 } );
+    $s->surveyJSON_update( [ 3, $qIndex, 1 ], { value => 0 } ); # Set 'No' score to 0
+}
+
+$s->surveyJSON_update( [ 4, 0 ], { questionType => 'Concern' } );
 
 # And finally, persist the changes..
 $s->persistSurveyJSON;
@@ -87,14 +94,14 @@ cmp_deeply(
     $s->responseJSON->surveyOrder, [
        [ 0, 0, [ 0, 1 ] ],  # S0Q0
        [ 1, 0, [ 0, 1 ] ],  # S1Q0
-       [ 2, 0, [] ],     # S2Q0
-       [ 3, 0, [] ],     # S3Q0
-       [ 3, 1, [] ],     # S3Q1
-       [ 4, 0, [] ],     # S4Q0
-       [ 4, 1, [] ],     # S4Q1
+       [ 2, 0, [] ],        # S2Q0
+       [ 3, 0, [ 0, 1 ] ],  # S3Q0
+       [ 3, 1, [ 0, 1 ] ],  # S3Q1
+       [ 3, 2, [ 0, 1 ] ],  # S3Q2
+       [ 4, 0, [ 0 .. 10 ] ],        # S4Q0
+       [ 5 ],               # S5
      ], 'surveyOrder is correct'
 );
-
 cmp_deeply(
     $s->responseJSON->surveyOrderIndexByVariableName, 
     {   
@@ -107,9 +114,10 @@ cmp_deeply(
         'S3'   => 3,
         'S3Q0' => 3,
         'S3Q1' => 4,
-        'S4'   => 5,
-        'S4Q0' => 5,
-        'S4Q1' => 6,
+        'S3Q2' => 5,
+        'S4'   => 6,
+        'S4Q0' => 6,
+        'S5'   => 7,
     },
     'surveyOrderIndexByVariableName correct'
 );
@@ -140,8 +148,8 @@ $spec = <<END_SPEC;
 END_SPEC
 try_it( $t1, $spec, { tap => <<END_TAP } );
 1..2
-ok 1 - Page containing Section S0 Question S0Q0 jumps to S1
-ok 2 - Page containing Section S0 Question S0Q0 jumps to S1Q0
+ok 1 - Checking next on page containing Section S0 Question S0Q0
+ok 2 - Checking next on page containing Section S0 Question S0Q0
 END_TAP
 
 # deliberately pass in a spec that will fail
@@ -157,12 +165,31 @@ $spec = <<END_SPEC;
 END_SPEC
 try_it( $t1, $spec, { tap => <<END_TAP, fail => 1 } );
 1..1
-not ok 1 - Page containing Section S0 Question S0Q0 jumps to S2
+not ok 1 - Checking next on page containing Section S0 Question S0Q0
 # Compared next section/question
 #    got : 'S1' (<-- a section) and 'S1Q0' (<-- a question)
 # expect : 'S2'
 END_TAP
 
+# also fails if we don't answer all required questions
+$spec = <<END_SPEC;
+[
+    {
+       "test" : {
+            "S3Q0" : "Yes",
+            "next" : "S4", # fails because we missed S3Q1 and S3Q2
+       }
+    }
+]
+END_SPEC
+try_it( $t1, $spec, { tap => <<END_TAP, fail => 1 } );
+1..1
+not ok 1 - Checking next on page containing Section S3 Question S3Q0
+# Compared next section/question
+#    got : 'S3' (<-- a section) and 'S3Q0' (<-- a question)
+# expect : 'S4'
+END_TAP
+
 # now try it on a question that has branching, and doesn't start on the first page
 $spec = <<END_SPEC;
 [
@@ -176,24 +203,75 @@ $spec = <<END_SPEC;
 END_SPEC
 try_it( $t1, $spec, { tap => <<END_TAP } );
 1..1
-ok 1 - Page containing Section S1 Question S1Q0 jumps to S3
+ok 1 - Checking next on page containing Section S1 Question S1Q0
 END_TAP
 
-# Use tags..
+# use our own description
+$spec = <<END_SPEC;
+[
+    {
+       "test" : {
+            "S1Q0" : "Yes",
+            "next" : "S3", # a goto jump
+       },
+       "name" : "my individual test label"
+    },
+]
+END_SPEC
+try_it( $t1, $spec, { tap => <<END_TAP } );
+1..1
+ok 1 - my individual test label
+END_TAP
+
+## Use tagged..
 $spec = <<END_SPEC;
 [
     {
        "test" : {
             "S0Q0" : "Yes",
             "next" : "S1",
-            "tags" : [ "tagged at S0Q0" ],  # and tagged correctly
+            "tagged" : [ "tagged at S0Q0" ],  # and tagged correctly
        }
     },
 ]
 END_SPEC
 try_it( $t1, $spec, { tap => <<END_TAP } );
 1..1
-ok 1 - Page containing Section S0 Question S0Q0 jumps to S1 and tags data
+ok 1 - Checking next and tagged on page containing Section S0 Question S0Q0
+END_TAP
+
+# Same but more verbose
+$spec = <<END_SPEC;
+[
+    {
+       "test" : {
+            "S0Q0" : "Yes",
+            "next" : "S1",
+            "tagged" : [ { "tagged at S0Q0" : 1 }, ],  # and tagged correctly
+       }
+    },
+]
+END_SPEC
+try_it( $t1, $spec, { tap => <<END_TAP } );
+1..1
+ok 1 - Checking next and tagged on page containing Section S0 Question S0Q0
+END_TAP
+
+# Also the same (uses hash instead of array)
+$spec = <<END_SPEC;
+[
+    {
+       "test" : {
+            "S0Q0" : "Yes",
+            "next" : "S1",
+            "tagged" : { "tagged at S0Q0" : 1 },
+       }
+    },
+]
+END_SPEC
+try_it( $t1, $spec, { tap => <<END_TAP } );
+1..1
+ok 1 - Checking next and tagged on page containing Section S0 Question S0Q0
 END_TAP
 
 # Use setup..
@@ -201,17 +279,17 @@ $spec = <<END_SPEC;
 [
     {
        "test" : {
-           "setup" : { "S0Q0" : "Yes" }, # S0Q0 tags 'tagged at S0Q0'
+           "setup" : { "S0Q0" : "Yes" }, # S0Q0 tagged 'tagged at S0Q0'
             "S1Q0" : "No",               
             "next" : "S2",
-            "tags" : [ "tagged at S0Q0" ],  # tagged by setup step
+            "tagged" : [ "tagged at S0Q0" ],  # tagged by setup step
        }
     },
 ]
 END_SPEC
 try_it( $t1, $spec, { tap => <<END_TAP } );
 1..1
-ok 1 - Page containing Section S1 Question S1Q0 jumps to S2 and tags data
+ok 1 - Checking next and tagged on page containing Section S1 Question S1Q0
 END_TAP
 
 # Use nested setup..
@@ -221,20 +299,39 @@ $spec = <<END_SPEC;
        "test" : {
            "setup" : { 
                "setup" : { 
-                   "S0Q0" : "Yes"            # tags 'tagged at S0Q0'
+                   "S0Q0" : "Yes"            # tagged 'tagged at S0Q0'
                },
-               "S1Q0" : "No",                # tags 'tagged at S1Q0'
+               "S1Q0" : "No",                # tagged 'tagged at S1Q0' with value 999
             }, 
             "S2Q0" : null,
             "next" : "S3",
-            "tags" : [ "tagged at S0Q0", "tagged at S1Q0", ],  # tagged by setup step
+            "tagged" : [ "tagged at S0Q0", { "tagged at S1Q0" : 999 }, ],  # tagged by setup step
        }
     },
 ]
 END_SPEC
 try_it( $t1, $spec, { tap => <<END_TAP } );
 1..1
-ok 1 - Page containing Section S2 Question S2Q0 jumps to S3 and tags data
+ok 1 - Checking next and tagged on page containing Section S2 Question S2Q0
+END_TAP
+
+# Use the score option
+$spec = <<END_SPEC;
+[
+    {
+       "test" : {
+            "S3Q0"  : "n",
+            "S3Q1"  : "y",
+            "S3Q2"  : "y",
+            "next"  : "S4",
+            "score" : { "S3" : 2 },
+       }
+    },
+]
+END_SPEC
+try_it( $t1, $spec, { tap => <<END_TAP } );
+1..1
+ok 1 - Checking next and score on page containing Section S3 Question S3Q0
 END_TAP
 
 #########
@@ -254,8 +351,8 @@ $spec = <<END_SPEC;
 END_SPEC
 try_it( $t1, $spec, { tap => <<END_TAP } );
 1..2
-ok 1 - S0Q0 mc answer 1 jumps to S1Q0
-ok 2 - S0Q0 mc answer 2 jumps to S1
+ok 1 - Checking next for S0Q0 mc answer 1
+ok 2 - Checking next for S0Q0 mc answer 2
 END_TAP
 
 # try the same thing, but in a more verbose form
@@ -272,18 +369,18 @@ $spec = <<END_SPEC;
 END_SPEC
 try_it( $t1, $spec, { tap => <<END_TAP } );
 1..2
-ok 1 - S0Q0 mc answer 1 jumps to S1Q0
-ok 2 - S0Q0 mc answer 2 jumps to S1
+ok 1 - Checking next for S0Q0 mc answer 1
+ok 2 - Checking next for S0Q0 mc answer 2
 END_TAP
 
-# use the tags option
+# use the tagged option
 $spec = <<END_SPEC;
 [ 
     { 
         "test_mc" : [ 
             "S0Q0",                             # test S0Q0
             {   "next" : "S1Q0",                # first answer falls through
-                "tags" : [ "tagged at S0Q0" ],  # and tags data
+                "tagged" : [ "tagged at S0Q0" ],  # and tagged data
             },    
             { "next" : "S1" },                  # second answer falls through to the same place
         ]
@@ -292,8 +389,8 @@ $spec = <<END_SPEC;
 END_SPEC
 try_it( $t1, $spec, { tap => <<END_TAP } );
 1..2
-ok 1 - S0Q0 mc answer 1 jumps to S1Q0 and tags correct
-ok 2 - S0Q0 mc answer 2 jumps to S1
+ok 1 - Checking next and tagged for S0Q0 mc answer 1
+ok 2 - Checking next for S0Q0 mc answer 2
 END_TAP
 
 # And try one that does branching, and doesn't start on the first page
@@ -303,7 +400,7 @@ $spec = <<END_SPEC;
         "test_mc" : [ 
             "S1Q0",                             # test S1Q0
             {   "next" : "S3",                  # first answer jumps
-                "tags" : [ ],                   # nothing gets tagged
+                "tagged" : [ ],                   # nothing gets tagged
             },
             { "next" : "S2" },                  # second answer falls through
         ]
@@ -312,8 +409,29 @@ $spec = <<END_SPEC;
 END_SPEC
 try_it( $t1, $spec, { tap => <<END_TAP } );
 1..2
-ok 1 - S1Q0 mc answer 1 jumps to S3 and tags correct
-ok 2 - S1Q0 mc answer 2 jumps to S2
+ok 1 - Checking next and tagged for S1Q0 mc answer 1
+ok 2 - Checking next for S1Q0 mc answer 2
+END_TAP
+
+#########
+# sequence
+#########
+$spec = <<END_SPEC;
+[ 
+    { 
+        "sequence" : { 
+            "S1Q0" : { "recordedAnswer" : "desc", "score" : "cons" }, # This is a default Yes/No (score all 1)
+            "S4Q0" : { "recordedAnswer" : "asc" },                    # Certainty scale, with recordedAnswer 0 .. 11
+            "S3Q0" : { "recordedAnswer" : "desc", "score" : "desc" }, # These 3 are yes/no questions where we have
+            "S3Q1" : { "recordedAnswer" : "desc", "score" : "desc" }, # ..set the score on the No answer to zero, hence
+            "S3Q2" : { "recordedAnswer" : "desc", "score" : "desc" }, # ..they are descending
+        }
+    }
+]
+END_SPEC
+try_it( $t1, $spec, { tap => <<END_TAP } );
+1..1
+ok 1 - Valid sequences
 END_TAP
 
 use TAP::Parser;