Survey test suite now functional.

Tests are defined via a JSON-encoded spec, through Web Crud interface
Test results are TAP encoded, and TAP parsed and prettified into HTML
Added i18n, help and tests

docs/upgrades/upgrade_7.7.5-7.7.6.pl

@@ -42,6 +42,7 @@ sendWebguiStats($session);
 addDataFormColumns($session);
 addListingsCacheTimeoutToMatrix( $session );
 addSurveyFeedbackTemplateColumn( $session );
+addSurveyTestResultsTemplateColumn( $session );
 installCopySender($session);
 installNotificationsSettings($session);
 installSMSUserProfileFields($session);
@@ -227,6 +228,16 @@ sub addSurveyFeedbackTemplateColumn {
 
 }
 
+#----------------------------------------------------------------------------
+sub addSurveyTestResultsTemplateColumn {
+    my $session = shift;
+    print "\tAdding columns for Survey Test Results Template..." unless $quiet;
+    $session->db->write("alter table Survey add column `testResultsTemplateId` char(22)");
+
+    print "Done\n" unless $quiet;
+
+}
+
 #----------------------------------------------------------------------------
 # Your sub here
 sub installCopySender {

lib/WebGUI/Asset/Wobject/Survey.pm

@@ -192,6 +192,14 @@ sub definition {
             defaultValue => 'PBtmpl0000000000000062',
             namespace    => 'Survey/Gradebook',
         },
+        testResultsTemplateId => {
+            tab          => 'display',
+            fieldType    => 'template',
+            label        => $i18n->get('Test Results Template'),
+            hoverHelp    => $i18n->get('Test Results Template help'),
+            defaultValue => 'S3zpVitAmhy58CAioH359Q',
+            namespace    => 'Survey/TestResults',
+        },
         surveyJSON => {
             fieldType    => 'text',
             defaultValue => '',
@@ -2455,6 +2463,7 @@ sub www_editTestSuite {
                .  $icon->edit(    'func=editTest;testId='.$id)
                .  $icon->moveDown('func=demoteTest;testId='.$id)
                .  $icon->moveUp(  'func=promoteTest;testId='.$id)
+               .  qq{<a href="} . $session->url->page("func=runTest;testId=$id") . qq{">Run Test</a>}
                .  '</td><td>'.$name.'</td></tr>';
     }
     $tests .= '</tbody></table><div style="clear: both;"></div>';
@@ -2621,6 +2630,84 @@ sub www_promoteTest {
 	return $self->www_editTestSuite;
 }
 
+#-------------------------------------------------------------------
+
+=head2 www_runTest ( )
+
+Runs a test
+
+=cut
+
+sub www_runTest {
+    my $self = shift;
+    my $session = $self->session;
+    
+    return $self->session->privilege->insufficient()
+        unless $self->session->user->isInGroup( $self->get('groupToEditSurvey') );
+    
+    my $id = $session->form->get("testId");
+    
+    my $test = WebGUI::Asset::Wobject::Survey::Test->new($session, $id)
+        or return $self->www_editTestSuite('Unable to find test');
+    
+    my $result = $test->run or return $self->www_editTestSuite('Unable to run test');
+    
+    my $tap = $result->{tap} or return $self->www_editTestSuite('Unable to determine test result');
+    
+    $self->session->log->debug("Got tap: [$tap]");
+    use TAP::Parser;
+    my $parser = TAP::Parser->new( { tap => $tap } );
+    
+    # Expose TAP::Parser and TAP::Parser::Result info as template variables
+    my $var = {
+        results => [],
+    };
+    
+    while ( my $result = $parser->next ) {
+        my $rvar = {};
+        for my $key (qw(
+            is_plan is_pragma is_test is_comment is_bailout is_version is_unknown
+            raw
+            type
+            as_string
+            is_ok
+            has_directive
+            has_todo
+            has_skip
+           )) { 
+           $rvar->{$key} = $result->$key; 
+        }
+        push @{$var->{results}}, $rvar;
+    }
+
+    # add summary results
+    for my $key (qw(
+        passed
+        failed
+        actual_passed
+        actual_failed
+        todo
+        todo_passed
+        skipped
+        plan
+        tests_planned
+        tests_run
+        skip_all
+        has_problems
+        exit
+        wait
+        parse_errors
+       )) { 
+       $var->{$key} = $parser->$key; 
+    }
+
+    my $ac = $self->getAdminConsole;
+    my $out = $self->processTemplate($var, $self->get('testResultsTemplateId'));
+    my $edit = WebGUI::International->new($self->session, "WebGUI")->get(575);
+    $ac->addSubmenuItem($self->session->url->page("func=editTest;testId=$id"), "$edit Test");
+    return $ac->render($out, 'Test Results');
+}
+
 ##-------------------------------------------------------------------
 #
 #=head2 www_settings ( )

lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm

@@ -332,6 +332,49 @@ sub surveyOrder {
     return $self->response->{surveyOrder};
 }
 
+
+#-------------------------------------------------------------------
+
+=head2 surveyOrderIndexByVariableName
+
+Returns a lookup table of variable names to surveyOrder index
+
+Only questions with a defined variable name set are included.
+
+=cut
+
+sub surveyOrderIndexByVariableName {
+    my $self = shift;
+    
+    my %lookup;
+    
+    # Iterate over items in surveyOrder..
+    my $i = 0;
+    for my $address ( @{ $self->surveyOrder } ) {
+        next if !$address;
+
+        # Retreive the section and question for this address..
+        my $section  = $self->survey->section($address);
+        my $question = $self->survey->question($address);
+        
+        if (my $var = $section && $section->{variable} ) {
+            # Section variables appear for every question, only store lowest index
+            if (!exists $lookup{$var} || $lookup{$var} > $i) {
+                $lookup{$var} = $i;
+            }
+        }
+        
+        if (my $var = $question && $question->{variable} ) {
+            $lookup{$var} = $i;
+        }
+
+        # Increment the item index counter
+        $i++;
+    }
+    
+    return \%lookup;
+}
+
 #-------------------------------------------------------------------
 
 =head2 nextResponse ([ $responseIndex ])

lib/WebGUI/Asset/Wobject/Survey/Test.pm

@@ -1,7 +1,12 @@
 package WebGUI::Asset::Wobject::Survey::Test;
 
+use strict;
 use base qw/WebGUI::Crud/;
 use WebGUI::International;
+use Test::Deep::NoTest;
+use JSON -support_by_pp; # so that we can still use allow_barekey etc..
+use Params::Validate qw(:all);
+Params::Validate::validation_options( on_fail => sub { WebGUI::Error::InvalidParam->throw( error => shift ) } );
 
 =head1 NAME
 
@@ -31,10 +36,6 @@ Survey_test
 
 testId
 
-=head3 assetId
-
-testId
-
 =head3 sequenceKey
 
 assetId, e.g. each Survey instance has its own sequence of tests.
@@ -49,9 +50,9 @@ Identifies the Survey instance.
 
 A name for the test
 
-=head4 test
+=head4 spec
 
-The test code
+The test spec
 
 =cut
 
@@ -73,16 +74,315 @@ sub crud_definition {
         hoverHelp    => $i18n->get( 'test name help', 'Asset_Survey' ),
         defaultValue => '',
     };
-    $properties->{test} = {
+    $properties->{spec} = {
         fieldType    => 'codearea',
-        label        => $i18n->get( 'test code', 'Asset_Survey' ),
+        label        => $i18n->get( 'test spec', 'Asset_Survey' ),
-        hoverHelp    => $i18n->get( 'test code help', 'Asset_Survey' ),
+        hoverHelp    => $i18n->get( 'test spec help', 'Asset_Survey' ),
-        syntax       => 'perl',
+        syntax       => 'js',
-        defaultValue => 'test()',
+        defaultValue => <<END_SPEC,
+[
+    {
+        test: {},
+    },
+]
+END_SPEC
     };
     return $definition;
 }
 
-1;
+=head2 run
 
-#vim:ft=perl
+Run this test. Returns TAP in a hashref.
+
+=cut
+
+sub run {
+    my $self = shift;
+    my $session = $self->session;
+    
+    if ( !$session->config->get('enableSurveyExpressionEngine') ) {
+        return { tap => 'Bail Out! enableSurveyExpressionEngine config option disabled' };
+    }
+    
+    my $spec = $self->get('spec') 
+        or return { tap => "Bail Out! Test spec undefined" };
+    
+    eval {
+        $spec = from_json($spec, { relaxed => 1, allow_barekey => 1, allow_singlequote => 1,  } );
+    };
+    
+    if ($@) {
+        my $error = $@;
+        $error =~ s/(.*?) at .*/$1/s;    # don't reveal too much
+        return { tap => "Bail Out! Invalid test spec: $error" };
+    }
+    
+    my $assetId = $self->get('assetId');
+    my $survey = WebGUI::Asset::Wobject::Survey->new($session, $assetId);
+    if (!$survey || !$survey->isa('WebGUI::Asset::Wobject::Survey') ) {
+        return { tap => "Bail Out! Unable to instantiate Survey using assetId: $assetId" };
+    }
+    
+    # Remove existing responses for current user
+    $self->session->db->write( 'delete from Survey_response where assetId = ? and userId = ?',
+        [ $self->getId, $self->session->user->userId() ] );
+    
+    # disable cookies so that test code doesn't die
+    $survey->responseIdCookies(0); 
+    
+    # Start a response as current user
+    my $responseId = $survey->responseId($self->session->user->userId)
+        or return { tap => "Bail Out! Unable to start survey response" };
+    
+    # Prepare the ingredients..
+    my $rJSON = $survey->responseJSON 
+        or return { tap => "Bail Out! Unable to get responseJSON" };
+        
+    my %validTargets = map { $_ => 1 } @{$survey->surveyJSON->getGotoTargets};
+    my $surveyOrder = $rJSON->surveyOrder;
+    my $surveyOrderIndexByVariableName = $rJSON->surveyOrderIndexByVariableName;
+    
+    # Run the tests
+    my $testCount = 0;
+    my @tap;
+    for my $item (@$spec) {
+        $self->_resetResponses($rJSON);
+        $rJSON->lastResponse(-1);
+        if (my $args = $item->{test} ) {
+            push @tap, $self->_test( { 
+                responseJSON => $rJSON, 
+                surveyOrder =>  $surveyOrder,
+                surveyOrderIndexByVariableName => $surveyOrderIndexByVariableName,
+                args => $args,
+                testCount_ref => \$testCount,
+            } );
+        } 
+        elsif (my $args = $item->{test_mc} ) {
+            push @tap, $self->_test_mc( { 
+                responseJSON => $rJSON, 
+                surveyOrder =>  $surveyOrder,
+                surveyOrderIndexByVariableName => $surveyOrderIndexByVariableName,
+                args => $args,
+                testCount_ref => \$testCount,
+            } );
+        } 
+        else {
+            push @tap, "Bail Out!";
+        }
+    }
+    
+    my $tap = "1..$testCount\n";
+    $tap .= join "\n", @tap;
+    return { tap => "$tap" };
+}
+
+=head2 _resetResponses
+
+Private convenience sub to carry out the task of resetting a response between tests
+
+=cut
+
+sub _resetResponses {
+    my ($self, $rJSON) = @_;
+    $rJSON->responses( {} );
+    $rJSON->lastResponse(-1);
+}
+
+=head2 _test
+
+Private sub. Triggered when a test spec requests "test".
+
+In the test spec, keys without special meaning are assumed to be question/section vars.
+The "next" key is special, indicating what section/question you expect the survey to
+end up at after responses have been submitted.
+
+=cut
+
+sub _test {
+    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 },
+    });
+    
+    # assemble the top-level ingredients..
+    my $rJSON = $opts{responseJSON};
+    my $surveyOrder = $opts{surveyOrder};
+    my $surveyOrderIndexByVariableName = $opts{surveyOrderIndexByVariableName};
+    my $args = $opts{args};
+    my $testCount = ++${$opts{testCount_ref}};
+    
+    # ..and the test-specific arguments
+    my $next = $args->{next};
+    delete $args->{next};
+    # n.b. everything left in %args assumed to be var => answer text
+    
+    # get starting page
+    
+    # Record responses
+    my $responses = {};
+    while ( my ( $variable, $answerText ) = each %$args ) {
+        my $index = $surveyOrderIndexByVariableName->{$variable};
+        my $address = $surveyOrder->[$index];
+        my $answerAddress;
+        
+        my $question = $rJSON->survey->question($address);
+        my $answer;
+        my $aIndex = 0;
+        for my $a (@{$question->{answers}}) {
+            if ($a->{text} =~ m/\Q$answerText\E/i) {
+                $answerAddress = "$address->[0]-$address->[1]-$aIndex";
+                $answer = $a;
+            }
+            $aIndex++;
+        }
+        if (!$answer || $answerAddress !~ m/\d+-\d+-\d+/) {
+            return <<END_TAP;
+not ok $testCount - next $next
+# answerText $answerText does not match any answers in your survey
+END_TAP
+        }
+        my $recordedAnswer = $answer->{recordedAnswer};
+        $responses->{$answerAddress} = $recordedAnswer;
+        $self->session->log->debug("Recording $variable ($answerAddress) => $recordedAnswer");
+    }
+    
+    return $self->_recordResponses( { 
+        responseJSON => $rJSON, 
+        responses => $responses, 
+        surveyOrder => $surveyOrder,
+        surveyOrderIndexByVariableName => $surveyOrderIndexByVariableName, 
+        next => $next,
+        testCount => $testCount,
+    });
+}
+
+=head2 _test_mc
+
+Private sub. Triggered when a test spec requests "test_mc".
+
+In the test spec, the first item is a section/question, and all remaining items are definitions
+of what you expect to happen next.
+
+=cut
+
+sub _test_mc {
+    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 => ARRAYREF },
+    });
+    
+    # assemble the top-level ingredients..
+    my $rJSON = $opts{responseJSON};
+    my $surveyOrder = $opts{surveyOrder};
+    my $surveyOrderIndexByVariableName = $opts{surveyOrderIndexByVariableName};
+    my $args = $opts{args};
+    
+    # the first item is the section/question
+    my $variable = shift @$args;
+    # ..and all remaining items are the specs
+    my @specs = @$args;
+    
+    my $index = $surveyOrderIndexByVariableName->{$variable};
+    my $address = $surveyOrder->[$index];
+    my $question = $rJSON->survey->question($address);
+    my $answers = $question->{answers};
+    
+    # Each spec is a sub-test, one per answer in the question
+    my @tap;
+    my $aIndex = 0;
+    for my $spec (@specs) {
+        $self->_resetResponses($rJSON);
+        my $responses = {};
+        my $testCount = ++${$opts{testCount_ref}};
+        
+        # assume spec can only be a target
+        my $next = $spec;
+        
+        my $answerAddress = "$address->[0]-$address->[1]-$aIndex";
+        my $answer = $answers->[$aIndex];
+        my $recordedAnswer = $answer->{recordedAnswer};
+        $responses->{$answerAddress} = $recordedAnswer;
+        $self->session->log->debug("Recording answer for mc question $variable at index $aIndex ($answerAddress) => $recordedAnswer");
+        push @tap, $self->_recordResponses( { 
+            responseJSON => $rJSON, 
+            responses => $responses, 
+            surveyOrder => $surveyOrder,
+            surveyOrderIndexByVariableName => $surveyOrderIndexByVariableName, 
+            next => $next,
+            testCount => $testCount,
+        });
+        
+        $aIndex++;
+    }
+    return @tap;
+}
+
+=head2 _recordResponses
+
+Private sub. Records responses and checks that you end up where you expect
+
+=cut
+
+sub _recordResponses {
+    my $self = shift;
+    my %opts = validate(@_, { 
+        responseJSON => { isa => 'WebGUI::Asset::Wobject::Survey::ResponseJSON' },
+        responses => { type => HASHREF },
+        surveyOrder => { type => ARRAYREF },
+        surveyOrderIndexByVariableName => { type => HASHREF },
+        next => 1,
+        testCount => 1,
+    });
+    
+    # assemble the top-level ingredients..
+    my $rJSON = $opts{responseJSON};
+    my $responses = $opts{responses};
+    my $surveyOrder = $opts{surveyOrder};
+    my $surveyOrderIndexByVariableName = $opts{surveyOrderIndexByVariableName};
+    my $next = $opts{next};
+    my $testCount = $opts{testCount};
+    
+    $rJSON->recordResponses($responses);
+
+    # Check where we end up
+    my $nextResponse = $rJSON->nextResponse;
+    my $nextAddress = $surveyOrder->[$nextResponse];
+    my $nextSection = $rJSON->survey->section($nextAddress);
+    my $nextQuestion = $rJSON->survey->question($nextAddress);
+    
+    # Get the lowest section surveyOrderIndex from lookup
+    my $got;
+    my $svar = $nextSection->{variable};
+    my $qvar = $nextQuestion->{variable};
+    if ($surveyOrderIndexByVariableName->{$svar} == $nextResponse) {
+        $got = "$svar (<-- a section)";
+        $got .= " and $qvar (<-- a question)" if $qvar;
+    } elsif ($qvar) {
+        $got = "$qvar (<-- a question)";
+    } else {
+        $got = 'Unknown!';
+    }
+    
+    my $expectedNextResponse = $surveyOrderIndexByVariableName->{$next};
+    if ($nextResponse != $expectedNextResponse) {
+        chomp (my $tap = <<END_TAP);
+not ok $testCount - next $next
+# Compared next section/question
+#    got : $got
+# expect : $next
+END_TAP
+        return $tap;
+    }
+    
+    return "ok $testCount";
+}
+
+1;

lib/WebGUI/Help/Asset_Survey.pm

@@ -37,6 +37,9 @@ our $HELP = {
             {   tag       => 'survey feedback template',
                 namespace => 'Asset_Survey'
             },  
+            {   tag       => 'survey test results template',
+                namespace => 'Asset_Survey'
+            }, 
         ]
     },
 
@@ -103,6 +106,9 @@ our $HELP = {
             {   tag       => 'survey feedback template',
                 namespace => 'Asset_Survey'
             },  
+            {   tag       => 'survey test results template',
+                namespace => 'Asset_Survey'
+            }, 
         ]
     },
 
@@ -175,6 +181,9 @@ our $HELP = {
             {   tag       => 'survey feedback template',
                 namespace => 'Asset_Survey'
             },   
+            {   tag       => 'survey test results template',
+                namespace => 'Asset_Survey'
+            },      
         ]
     },
 
@@ -222,6 +231,9 @@ our $HELP = {
             {   tag       => 'survey feedback template',
                 namespace => 'Asset_Survey'
             },  
+            {   tag       => 'survey test results template',
+                namespace => 'Asset_Survey'
+            }, 
         ]
     },
 
@@ -269,6 +281,9 @@ our $HELP = {
             {   tag       => 'survey feedback template',
                 namespace => 'Asset_Survey'
             },  
+            {   tag       => 'survey test results template',
+                namespace => 'Asset_Survey'
+            }, 
         ]
     },
 
@@ -311,6 +326,9 @@ our $HELP = {
             {   tag       => 'survey feedback template',
                 namespace => 'Asset_Survey'
             },  
+            {   tag       => 'survey test results template',
+                namespace => 'Asset_Survey'
+            }, 
         ]
     },
 
@@ -396,6 +414,39 @@ our $HELP = {
             { name => 'timeoutRestart', description => 'response timeout restart help' },
             { name => 'endDate', description => 'response endDate help' },
         ],
+         related => [
+            {   tag       => 'survey template',
+                namespace => 'Asset_Survey'
+            },
+            {   tag       => 'statistical overview report template',
+                namespace => 'Asset_Survey'
+            },
+            {   tag       => 'gradebook report template',
+                namespace => 'Asset_Survey'
+            },
+            {   tag       => 'survey section edit template',
+                namespace => 'Asset_Survey'
+            },
+            {   tag       => 'survey question edit template',
+                namespace => 'Asset_Survey'
+            },
+            {   tag       => 'survey answer edit template',
+                namespace => 'Asset_Survey'
+            },          
+            {   tag       => 'survey feedback template',
+                namespace => 'Asset_Survey'
+            },  
+            {   tag       => 'survey test results template',
+                namespace => 'Asset_Survey'
+            },  
+        ]
+    },
+    
+    'survey test results template' => {
+        title   => 'survey test results template title',
+        body => 'survey test results template body',
+        isa     => [],
+        fields    => [],
          related => [
             {   tag       => 'survey template',
                 namespace => 'Asset_Survey'

lib/WebGUI/i18n/English/Asset_Survey.pm

@@ -991,6 +991,16 @@ directly inside the answer_loop for other types of questions.|,
         lastUpdated => 1242180657,
     },
     
+    'survey test results template title' => {
+        message => q|Survey Test Results Template Variables|,
+        lastUpdated => 1242256111,
+    },
+
+    'survey test results template body' => {
+        message => q|All TAP::Parser and TAP::Parser::Result fields are exposed as template variables|,
+        lastUpdated => 0,
+    },
+
     'maxResponsesSubmitted' => {
         message => q|A boolean indicating whether the current user has reached the maximum number of responses.|,
         context => q|Description of a template variable for a template Help page.|,
@@ -1559,13 +1569,13 @@ section/answer.|,
         lastUpdated => 0,
     },
     
-    'test code' => {
+    'test spec' => {
-        message => q{Test Code},
+        message => q{Test Spec},
         lastUpdated => 0,
     },
     
-    'test code help' => {
+    'test spec help' => {
-        message => q{The test code},
+        message => q{The JSON-encoded specification for your test(s)},
         lastUpdated => 0,
     },
 

t/Asset/Wobject/Survey/ResponseJSON.t

@@ -22,7 +22,7 @@ my $session = WebGUI::Test->session;
 
 #----------------------------------------------------------------------------
 # Tests
-my $tests = 96;
+my $tests = 97;
 plan tests => $tests + 1;
 
 #----------------------------------------------------------------------------
@@ -321,6 +321,25 @@ is($rJSON->lastResponse(), 0, 'goto: works on existing question');
 $rJSON->processGoto('goto 3-0');
 is($rJSON->lastResponse(), 5, 'goto: finds first if there are duplicates');
 
+####################################################
+#
+# surveyOrderIndexByVariableName
+#
+####################################################
+my $expect = {
+    'goto 0' => 0,
+   'goto 0-0' => 0,
+   'goto 0-1' => 1,
+   'goto 0-2' => 2,
+   'goto 1' => 3,
+   'goto 1-0' => 3,
+   'goto 1-1' => 4,
+   'goto 2' => 5,
+   'goto 3-0' => 7,
+   'goto 3-2' => 8,
+};
+cmp_deeply($rJSON->surveyOrderIndexByVariableName(), $expect, 'surveyOrderIndexByVariableName');
+
 ####################################################
 #
 # responseScoresByVariableName

t/Asset/Wobject/Survey/Test.t

@@ -0,0 +1,176 @@
+# Tests WebGUI::Asset::Wobject::Survey::SurveyJSON
+#
+#
+
+use strict;
+use warnings;
+use FindBin;
+use lib "$FindBin::Bin/../../../lib";
+use Test::More;
+use Test::Deep;
+use Test::Exception;
+use Data::Dumper;
+use WebGUI::Test;    # Must use this before any other WebGUI modules
+use WebGUI::Session;
+use JSON;
+use Clone qw/clone/;
+
+#----------------------------------------------------------------------------
+# Init
+my $session = WebGUI::Test->session;
+
+#----------------------------------------------------------------------------
+# Tests
+plan tests => 16;
+
+my ( $s, $t1 );
+
+#----------------------------------------------------------------------------
+# put your tests here
+use_ok('WebGUI::Asset::Wobject::Survey::Test');
+
+my $user = WebGUI::User->new( $session, 'new' );
+WebGUI::Test->usersToDelete($user);
+my $import_node = WebGUI::Asset->getImportNode($session);
+
+# Create a Survey
+$s = $import_node->addChild( { className => 'WebGUI::Asset::Wobject::Survey', } );
+isa_ok( $s, 'WebGUI::Asset::Wobject::Survey' );
+
+$s->responseIdCookies(0);
+
+# Load bare-bones survey, containing a single section (S0)
+$s->surveyJSON_update( [0], { variable => 'S0' } );
+
+# Section 0 has a single question, S0Q0, which is a Yes/No muti-choice
+$s->surveyJSON_newObject( [0] );                             # S0Q0
+$s->surveyJSON_update( [ 0, 0 ], { variable => 'S0Q0' } );
+$s->surveyJSON->updateQuestionAnswers( [ 0, 0 ], 'Yes/No' );
+
+# Add a new section (S1)
+$s->surveyJSON_newObject( [] );
+$s->surveyJSON_update(    [1], { variable => 'S1' } );
+$s->surveyJSON_newObject( [1] );
+$s->surveyJSON_newObject( [1] );
+$s->surveyJSON_update(    [ 1, 0 ], { variable => 'S1Q0' } );
+$s->surveyJSON_update(    [ 1, 1 ], { variable => 'S1Q1' } );
+
+$s->persistSurveyJSON;
+
+cmp_deeply(
+    $s->responseJSON->surveyOrder,
+    [ [ 0, 0, [ 0, 1 ] ], [ 1, 0, [0] ], [ 1, 1, [0] ] ],
+    'At this stage our surveyOrder has 3 items'
+);
+
+cmp_deeply(
+    $s->responseJSON->surveyOrderIndexByVariableName,
+    {   'S0'   => 0,
+        'S0Q0' => 0,
+        'S1'   => 1,
+        'S1Q0' => 1,
+        'S1Q1' => 2,
+    },
+    '..which corresponds to'
+);
+
+$t1 = WebGUI::Asset::Wobject::Survey::Test->create( $session, { assetId => $s->getId } );
+my ($spec, $tap);
+
+$spec = <<END_SPEC;
+[
+    {
+       test : {
+            S0Q0 : 'Yes',
+            next : "S1",
+       }
+    },
+    {
+       test : {
+            S0Q0 : 'No',
+            next : "S1",
+       }
+    }
+]
+END_SPEC
+$tap = <<END_TAP;
+1..2
+ok 1
+ok 2
+END_TAP
+try_it($t1, $spec, { tap => $tap });
+
+# add a goto into the mix
+$s->surveyJSON_update( [ 0, 0, 0 ], { goto => 'S1Q1' } );
+# deliberately pass in a spec that will fail
+$spec = <<END_SPEC;
+[ { test : { 
+        S0Q0 : 'Yes',
+        next : "S1", # this will fail here, because Yes now jumps to S1Q1
+    } 
+  },
+  { test : { 
+        S0Q0 : 'No',
+        next : "S1",
+    }
+} ]
+END_SPEC
+my $tap2 = <<END_TAP;
+1..2
+not ok 1 - next S1
+# Compared next section/question
+#    got : S1Q1 (<-- a question)
+# expect : S1
+ok 2
+END_TAP
+try_it($t1, $spec, { tap => $tap2, fail => 1 });
+
+# try now with a spec that will pass
+$spec = <<END_SPEC;
+[ { test : { 
+        S0Q0 : 'Yes',
+        next : "S1Q1", # jumps
+    } 
+  },
+  { test : { 
+        S0Q0 : 'No',
+        next : "S1", # falls through
+    }
+} ]
+END_SPEC
+try_it($t1, $spec, { tap => $tap });
+
+# Now use test_mc
+$spec = q{ [ { test_mc : [ 'S0Q0', 'S1Q1', 'S1' ] } ] };
+try_it($t1, $spec, { tap => $tap });
+
+
+
+use TAP::Parser;
+sub try_it {
+    my ($test, $spec, $opts) = @_;
+    chomp($spec);
+    
+    $test->update( { spec => $spec } );
+    my $result = $t1->run();
+    ok( $result, 'Tests ran ok' );
+    
+    if (my $tap = $opts->{tap}) {
+        chomp($tap);
+        is( $result->{tap}, $tap, 'TAP matches' );
+    }
+    
+    my $parser = TAP::Parser->new( $result );
+    while (my $r = $parser->next) {
+        # we could test extra stuff here, but mainly we just need to make the parser
+        # go all the way through so that we can access ->has_problems
+    }
+    ok(!$parser->has_problems == !$opts->{fail}, ($opts->{fail} ? "Fails" : "Passes") . ' as expected');
+}
+
+#----------------------------------------------------------------------------
+# Cleanup
+END {
+    $s->purge() if $s;
+    $t1->delete();
+}