Skip to content

Instantly share code, notes, and snippets.

@Xliff

Xliff/Porting Difficulties.md

Last active June 13, 2016 11:39
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save Xliff/bc0a12bcb213d6426a93684fde829193 to your computer and use it in GitHub Desktop.
Save Xliff/bc0a12bcb213d6426a93684fde829193 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
Porting Difficulties.md

OK, so I have the following test script:

use v6.c;
use Test;

#use base qw(ParentClass);
#
#sub new {
#    my $class = shift;
#    $class = ref $class if ref $class;
#    my $self = bless {}, $class;
#    $self;
#}

#1;

# Should be 187.
#use Test::More tests => 191;
plan 187;


use XML::LibXML;

my $foo       = "foo";
my $bar       = "bar";
my $nsURI     = "http://foo";
my $prefix    = "x";
my $attname1  = "A";
my $attvalue1 = "a";
my $attname2  = "B";
my $attvalue2 = "b";
my $attname3  = "C";

# TEST:$badnames=4;
my @badnames= ("1A", "<><", "&", "-:");

# 1. bound node
{
    my $doc = XML::LibXML::Document.new();
    my $elem = $doc.createElement( $foo );
    # TEST
    ok $elem, 'created element';
    isa-ok $elem, XML::LibXML::Node, 'element belongs to proper class';
    # TEST
    is $elem.name, $foo, 'element has correct tag name';

    diag $elem;
    {

        for @badnames -> $name {
            my $te = $elem;
            my $caught = 0;
            try {
                CATCH {
                    default {
                        ok True, "setNodeName throws an exception for $name";
                        $caught = 1;
                        # cw: We may need a way to say "resume from current scope"
                        #     because this seems to resume execution *from the
                        #     exact point where the exception is thrown!
                        .resume;
                    }
                }
                $te.setNodeName( $name );
                nok True, "setNodeName did not throw an exception for $name"
                    if $caught == 0;
            }
            # TEST*$badnames
        }
    }
    diag $elem;

    $elem.setAttribute( $attname1, $attvalue1 );
    # TEST
    ok $elem.hasAttribute($attname1), 'can set an element attribute';
    # TEST
    is $elem.getAttribute($attname1), $attvalue1, 'element attribute has correct value';

    my $attr = $elem.getAttributeNode($attname1);
    # TEST
    ok $attr, 'can retrieve attribute node';
    # TEST
    is $attr.name, $attname1, 'attribute name is properly set';
    # TEST
    is $attr.value, $attvalue1, 'attribute value is properly set';

    $elem.setAttribute( $attname1, $attvalue2 );
    # TEST -14
    is $elem.getAttribute($attname1), $attvalue2, 'retrieved correct attribute value via element';
    # TEST
    is $attr.value, $attvalue2, 'new value successfully propagated to attribute';

    # TEST - 16
    # cw: Do we really want to force pair or have a sensible multi?
    #my $attr2 = $doc.createAttribute($attname2 => $attvalue1);
    my $attr2 = $doc.createAttribute($attname2, $attvalue1);
    # TEST
    ok $attr2, 'created attribute';

    $attr2 = $doc.createAttribute($attname2 => $attvalue1);
    ok $attr2, 'created attribute using Pair syntax';

    diag "$elem / $attr2";
    $elem.setAttributeNode($attr2);

    # TEST
    ok $elem.hasAttribute($attname2), 'created attribute was assigned to element';
    # TEST
    is $elem.getAttribute($attname2),$attvalue1, 'created attribute has correct value';

    my $tattr = $elem.getAttributeNode($attname2);
    # TEST - ???
    ok $tattr.isSameNode($attr2), 'getAttributeNode returns same attribute object';

    $elem.setAttribute($attname2, "");
    # TEST
    ok $elem.hasAttribute($attname2), 'can assign blank attribute';
    # TEST
    is $elem.getAttribute($attname2), "", 'attribute is truly blank';

    $elem.setAttribute($attname3, "");
    # TEST
    ok $elem.hasAttribute($attname3), 'can blank a second attribute';
    # TEST
    is $elem.getAttribute($attname3), "", 'second attribute is also blank';

    # cw: Do we really need enclosing block?
    {
        for @badnames -> $name {
            try {
                my $caught = 0;
                CATCH {
                    # TEST*$badnames
                    ok True, "setAttribute throws an exxception for '$name'";
                    $caught = 1;
                    .resume;
                }
                $elem.setAttribute( $name, "X" );
                nok True, "setAttribute did not throw an exception for '$name'"
                    if $caught == 0;
            }
        }
    }
}

Which gives the following output:

1..187
ok 1 - created element
ok 2 - element belongs to proper class
ok 3 - element has correct tag name
# <foo/>
ok 4 - setNodeName throws an exception for 1A
ok 5 - setNodeName throws an exception for <><
ok 6 - setNodeName throws an exception for &
ok 7 - setNodeName throws an exception for -:
# <-:/>
ok 8 - can set an element attribute
ok 9 - element attribute has correct value
ok 10 - can retrieve attribute node
ok 11 - attribute name is properly set
ok 12 - attribute value is properly set
ok 13 - retrieved correct attribute value via element
not ok 14 - new value successfully propagated to attribute

# Failed test 'new value successfully propagated to attribute'
# at t/06elements-port.t line 94
# expected: 'b'
#      got: 'a'
ok 15 - created attribute
ok 16 - created attribute using Pair syntax
# <-: A="b"/> / XML::LibXML::Attr<242737496>
not ok 17 - created attribute was assigned to element

# Failed test 'created attribute was assigned to element'
# at t/06elements-port.t line 110
not ok 18 - created attribute has correct value

# Failed test 'created attribute has correct value'
# at t/06elements-port.t line 112
# expected: 'a'
#      got: (Str)
Method 'isSameNode' not found for invocant of class 'XML::LibXML::Attr'
  in block <unit> at t/06elements-port.t line 116

# Looks like you planned 187 tests, but ran 18
# Looks like you failed 3 tests of 18

Problem #1 - setNodeName throws an exception, but the .resume from the test code doesn't return to the current scope. setNodeName looks like this:

method setNodeName(Str $n) {
  sub xmlNodeSetName(xmlNode, Str)       is native('xml2') { * }

  die "Bad name" if self!testNodeName($n);
  xmlNodeSetName(self, $n);
}

I could rewrite setNodeName, but why does .resume continue in the lower scope, rather than the one where the try/catch is defined?

Changing the above code to the following:

diag $elem;
{
    for @badnames -> $name {
        my $te = $elem;
        my $caught = 0;

            try $te.setNodeName( $name );
            CATCH {
                default {
                    ok True, "setNodeName throws an exception for $name";
                    $caught = 1;
                    # cw: We may need a way to say "resume from current scope"
                    #     because this seems to resume execution *from the
                    #     exact point where the exception is thrown!
                    .resume;
                }
            }
            nok True, "setNodeName did not throw an exception for $name"
                if $caught == 0;

        # TEST*$badnames
    }
}
diag $elem;

Still gives me improper results:

# <foo/>
not ok 4 - setNodeName did not throw an exception for 1A

# Failed test 'setNodeName did not throw an exception for 1A'
# at t/06elements-port.t line 68
not ok 5 - setNodeName did not throw an exception for <><

# Failed test 'setNodeName did not throw an exception for <><'
# at t/06elements-port.t line 68
not ok 6 - setNodeName did not throw an exception for &

# Failed test 'setNodeName did not throw an exception for &'
# at t/06elements-port.t line 68
not ok 7 - setNodeName did not throw an exception for -:

# Failed test 'setNodeName did not throw an exception for -:'
# at t/06elements-port.t line 68
# <-:/>

Please note that the first line is our current element "" and the last line should read "" as well, however it reads "<-:/>" which means execution still continues after our die in setNodeName().

Problem #2:

We have a scalar value that contains a pointer as passed from a C lib:

my $attr = $elem.getAttributeNode($attname1);

The value of the underling object is changed through the C lib:

$elem.setAttribute( $attname1, $attvalue2 );

However, this change is not reflected in $attr... and it should be. I'm pretty sure there an implied copy somewhere in the code and I am not catching it. If more detail is need, I will create another gist expressly for this issue.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment