hoxsl/test/record.xspec

<?xml version="1.0" encoding="utf-8"?>
<!--
  Tests records

  Copyright (C) 2015, 2016 Mike Gerwitz

    This file is part of hoxsl.

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
-->

<description xmlns="http://www.jenitennison.com/xslt/xspec"
             xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
             xmlns:x="http://www.jenitennison.com/xslt/xspec"
             xmlns:n="http://mikegerwitz.com/hoxsl/node"
             xmlns:R="http://mikegerwitz.com/hoxsl/record"
             xmlns:foo="http://mikegerwitz.com/_junk"
             stylesheet="../src/record.xsl">

  <variable name="test-qname"
            select="QName( 'http://mikegerwitz.com/_junk',
                           'foo:test-qname' )" />
  <variable name="test-qname-2"
            select="QName( 'http://mikegerwitz.com/_junk',
                           'foo:test-qname-2' )" />
  <variable name="test-qname-3"
            select="QName( 'http://mikegerwitz.com/_junk',
                           'foo:test-qname-3' )" />

  <variable name="slot-ns" as="xs:anyURI"
            select="resolve-uri( 'http://mikegerwitz.com/_junk/slot' )" />

  <variable name="sa" as="xs:QName"
            select="QName( $slot-ns, 'a' )" />
  <variable name="sb" as="xs:QName"
            select="QName( $slot-ns, 'b' )" />
  <variable name="sc" as="xs:QName"
            select="QName( $slot-ns, 'c' )" />
  <variable name="sd" as="xs:QName"
            select="QName( $slot-ns, 'd' )" />

  <scenario label="R:make-record-header">
    <scenario label="with no name">
      <call function="R:make-record-header">
        <param name="slots" select="3" />
      </call>

      <expect label="produces an R:Record element"
              test="$x:result instance of element( R:Record )" />

      <expect label="R:Record type matches the generic R:Record"
              test="R:is-a( $R:qname, $x:result )" />

      <expect label="R:Record type does not match other QName"
              test="not( R:is-a( $test-qname-2, $x:result ) )" />

      <expect label="R:Record element contains number of slots"
              test="R:slot-count( $x:result ) = 3" />
    </scenario>


    <scenario label="with no supertype">
      <call function="R:make-record-header">
        <param name="qname" select="$test-qname" />
        <param name="slots" select="3" />
      </call>

      <expect label="produces an R:Record element"
              test="$x:result instance of element( R:Record )" />

      <expect label="R:Record type matches the generic R:Record"
              test="R:is-a( $R:qname, $x:result )" />

      <expect label="R:Record type matches given QName"
              test="R:is-a( $test-qname, $x:result )" />

      <expect label="R:Record type does not match other QName"
              test="not( R:is-a( $test-qname-2, $x:result ) )" />

      <expect label="R:Record element contains number of slots"
              test="R:slot-count( $x:result ) = 3" />
    </scenario>


    <scenario label="with a supertype">
      <scenario label="produces">
        <call function="R:make-record-header">
          <param name="qname" select="$test-qname" />
          <param name="slots" select="3" />
          <param name="supertype"
                 select="R:make-record-header( $test-qname-2, 2 )" />
        </call>

        <expect label="produces an R:Record element"
                test="$x:result instance of element( R:Record )" />

        <expect label="R:Record type matches given QName"
                test="R:is-a( $test-qname, $x:result )" />

        <expect label="R:Record type matches supertype QName"
                test="R:is-a( $test-qname-2, $x:result )" />

        <expect label="R:Record type matches the generic R:Record"
                test="R:is-a( $R:qname, $x:result )" />

        <expect label="R:Record type does not match other QName"
                test="not( R:is-a( QName( '', 'foo' ), $x:result ) )" />
      </scenario>


      <scenario label="with slot count greater than that of supertype">
        <call function="R:make-record-header">
          <param name="qname" select="$test-qname" />
          <param name="slots" select="3" />
          <param name="supertype"
                 select="R:make-record-header( $test-qname-2, 2 )" />
        </call>

        <expect label="R:Record element contains given number of slots"
                test="R:slot-count( $x:result ) = 3" />
      </scenario>


      <scenario label="with slot count equal to that of supertype">
        <call function="R:make-record-header">
          <param name="qname" select="$test-qname" />
          <param name="slots" select="2" />
          <param name="supertype"
                 select="R:make-record-header( $test-qname-2, 2 )" />
        </call>

        <expect label="R:Record element contains given number of slots"
                test="R:slot-count( $x:result ) = 2" />
      </scenario>


      <scenario label="with slot count less than that of supertype">
        <call function="R:make-record-header">
          <param name="qname" select="$test-qname" />
          <param name="slots" select="1" />
          <param name="supertype"
                 select="R:make-record-header( $test-qname-2, 2 )" />
        </call>

        <expect label="R:Record element contains supertype slot count"
                test="R:slot-count( $x:result ) = 2" />
      </scenario>
    </scenario>


    <!-- arbitrary nesting of supertypes -->
    <scenario label="with a super-supertype">
      <scenario label="produces">
        <call function="R:make-record-header">
          <param name="qname" select="$test-qname" />
          <param name="slots" select="3" />
          <param name="supertype"
                 select="R:make-record-header(
                           $test-qname-2,
                           2,
                           R:make-record-header( $test-qname-3, 2 ))" />
        </call>

        <expect label="produces an R:Record element"
                test="$x:result instance of element( R:Record )" />

        <expect label="R:Record type matches given QName"
                test="R:is-a( $test-qname, $x:result )" />

        <expect label="R:Record type matches supertype QName"
                test="R:is-a( $test-qname-2, $x:result )" />

        <expect label="R:Record type matches super-supertype QName"
                test="R:is-a( $test-qname-3, $x:result )" />

        <expect label="R:Record type matches the generic R:Record"
                test="R:is-a( $R:qname, $x:result )" />

        <expect label="R:Record type does not match other QName"
                test="not( R:is-a( QName( '', 'foo' ), $x:result ) )" />
      </scenario>
    </scenario>
  </scenario>


  <scenario label="R:name-slots">
    <scenario label="not having been invoked on a record">
      <call function="R:make-record-header">
        <param name="qname" select="$test-qname" />
        <param name="slots" select="3" />
      </call>

      <expect label="produces no named slots"
              test="empty( R:slot-names( $x:result, $slot-ns ) )" />
    </scenario>


    <scenario label="with no names">
      <call function="R:name-slots">
        <param name="Record"
               select="R:make-record-header( $test-qname, 3 )" />
        <param name="names" select="()" />
      </call>

      <expect label="retains slot count"
              test="R:slot-count( $x:result ) = 3" />

      <expect label="produces no named slots"
              test="empty( R:slot-names( $x:result, $slot-ns ) )" />
    </scenario>


    <scenario label="with names less than slot count">
      <call function="R:name-slots">
        <param name="Record"
               select="R:make-record-header( $test-qname, 3 )" />
        <param name="names" select="( $sa, $sb )" />
      </call>

      <expect label="retains slot count"
              test="R:slot-count( $x:result ) = 3" />

      <expect label="produces given named slots"
              test="deep-equal( R:slot-names( $x:result, $slot-ns ),
                                ( n:attr( $sa, 1 ),
                                  n:attr( $sb, 2 ) ) )" />
    </scenario>


    <scenario label="with names greater than slot count N">
      <call function="R:name-slots">
        <param name="Record"
               select="R:make-record-header( $test-qname, 3 )" />
        <param name="names" select="( $sa, $sb, $sc, $sd )" />
      </call>

      <expect label="retains slot count"
              test="R:slot-count( $x:result ) = 3" />

      <expect label="produces only first N slot names"
              test="deep-equal( R:slot-names( $x:result, $slot-ns ),
                                ( n:attr( $sa, 1 ),
                                  n:attr( $sb, 2 ),
                                  n:attr( $sc, 3 ) ) )" />
    </scenario>


    <scenario label="invoked multiple times">
      <!-- need to use a node to assert on attributes -->
      <call function="n:element">
        <param name="qname" select="$test-qname" />
        <param name="attrs"
               select="R:slot-names(
                         R:name-slots(
                           R:name-slots(
                             R:make-record-header( $test-qname, 3 ),
                             ( $sa, $sb ) ),
                           ( $sd, $sc, $sb ) ),
                         $slot-ns)" />
      </call>

      <expect label="overwrites slots names already specified"
              test="count( $x:result/@* ) = 4
                      and ( every $x in $x:result/@* satisfies
                              deep-equal( $x, n:attr( $sd, 1 ) )
                                or deep-equal( $x, n:attr( $sa, 1 ) )
                                or deep-equal( $x, n:attr( $sc, 2 ) )
                                or deep-equal( $x, n:attr( $sb, 3 ) ) )" />
    </scenario>
  </scenario>


  <scenario label="Record data function">
    <!-- yes, this tests implementation details rather than relying on
         abstractions provided by the API; this is intentional to ensure
         that records are operating according to their specification -->
    <scenario label="R:init-slots">
      <variable name="anon-record"
                select="R:make-record-header( 3 )" />

      <call function="R:init-slots">
        <param name="Record" select="$anon-record" />
      </call>

      <expect label="produces a sequence of length 2N+2"
              test="count( $x:result ) eq 8" />

      <expect label="first item is record header"
              test="$x:result[ 1 ] = $anon-record" />

      <expect label="second item is record span"
              test="$x:result[ 2 ] = 8" />

      <expect label="R:record-span agrees with span item"
              test="R:record-span( $x:result ) = $x:result[ 2 ]" />

      <expect label="slot offsets are initialized to slot positions"
              test="$x:result[ 3 ] eq 1
                    and $x:result[ 4 ] eq 2
                    and $x:result[ 5 ] eq 3" />

      <expect label="slots are initialized with empty values"
              test="every $slot in subsequence( $x:result, 6 ) satisfies
                      $slot eq $R:empty-slot" />
    </scenario>


    <scenario label="R:is-record-seq">
      <scenario label="given an empty sequence">
        <call function="R:is-record-seq">
          <param name="seq"
                 select="()" />
        </call>

        <expect label="yields false()"
                test="$x:result eq false()" />
      </scenario>


      <scenario label="given a non-record header">
        <call function="R:is-record-seq">
          <param name="seq"
                 select="n:element( $test-qname )" />
        </call>

        <expect label="yields false()"
                test="$x:result eq false()" />
      </scenario>


      <scenario label="given a record header only">
        <call function="R:is-record-seq">
          <param name="seq"
                 select="R:make-record-header( 0 )" />
        </call>

        <expect label="yields false()"
                test="$x:result eq false()" />
      </scenario>


      <scenario label="given a record with sequence lt span">
        <call function="R:is-record-seq">
          <param name="seq"
                 select="subsequence(
                           R:init-slots(
                             R:make-record-header( 2 ) ),
                           1, 4 )" />
        </call>

        <expect label="yields false()"
                test="$x:result eq false()" />
      </scenario>


      <scenario label="given a full record sequence">
        <call function="R:is-record-seq">
          <param name="seq"
                 select="R:init-slots(
                           R:make-record-header( 2 ) )" />
        </call>

        <expect label="yields true()"
                test="$x:result eq true()" />
      </scenario>
    </scenario>


    <!-- see above scenario for record test -->
    <scenario label="R:record-span">
      <scenario label="given a non-record">
        <call function="R:record-span">
          <param name="Rseq"
                 select="n:element( $test-qname )" />
        </call>

        <expect label="returns the empty sequence"
                test="empty( $x:result )" />
      </scenario>


      <scenario label="given a record with an invalid span">
        <call function="R:record-span">
          <param name="Rseq"
                 select="R:make-record-header( 0 ), 'invalid'" />
        </call>

        <expect label="returns the empty sequence"
                test="empty( $x:result )" />
      </scenario>
    </scenario>
  </scenario>


  <scenario label="R:is-record">
    <scenario label="given a record">
      <call function="R:is-record">
        <param name="Record"
               select="R:make-record-header( 0 )" />
      </call>

      <expect label="returns true()"
              test="$x:result = true()" />
    </scenario>


    <scenario label="given a non-record element">
      <call function="R:is-record">
        <param name="Record"
               select="n:element( QName( '', 'foo' ) )" />
      </call>

      <expect label="returns false()"
              test="$x:result = false()" />
    </scenario>


    <scenario label="given a non-record atomic">
      <call function="R:is-record">
        <param name="Record"
               select="5" />
      </call>

      <expect label="returns false()"
              test="$x:result = false()" />
    </scenario>
  </scenario>


  <scenario label="R:is-compatible">
    <scenario label="with super- and sub-types of same slot count">
      <call function="R:is-compatible">
        <param name="A" select="R:make-record-header( $test-qname, 2 )" />
        <param name="B" select="R:make-record-header( $test-qname-2, 2 )" />
      </call>

      <expect label="yields true()"
              test="$x:result = true()" />
    </scenario>


    <scenario label="with subtype slot count greater than supertype">
      <call function="R:is-compatible">
        <param name="sub"
               select="R:make-record-header( $test-qname, 2 )" />
        <param name="super"
               select="R:make-record-header( $test-qname-2, 1 )" />
      </call>

      <expect label="yields true()"
              test="$x:result = true()" />
    </scenario>


    <scenario label="with subtype slot count less than supertype">
      <call function="R:is-compatible">
        <param name="sub"
               select="R:make-record-header( $test-qname, 1 )" />
        <param name="super"
               select="R:make-record-header( $test-qname-2, 2 )" />
      </call>

      <expect label="yields false()"
              test="$x:result = false()" />
    </scenario>
  </scenario>
</description>