Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
tree: b9261ad17c
Fetching contributors…

Cannot retrieve contributors at this time

251 lines (211 sloc) 5.82 kB
#!./parrot
# Copyright (C) 2001-2008, Parrot Foundation.
=head1 NAME
t/pmc/managedstruct.t - Managed C Structure
=head1 SYNOPSIS
% prove t/pmc/managedstruct.t
=head1 DESCRIPTION
Tests the ManagedStruct PMC. Checks element access and memory allocation.
=cut
.sub main :main
.include 'test_more.pir'
plan(26)
set_managedstruct_size()
element_access()
named_element_access_int16()
nested_struct_offsets()
interface_check()
destroy_custom()
#clone_custom()
realloc_free()
.end
.sub set_managedstruct_size
new $P0, ['ManagedStruct']
set $I0,$P0
is($I0, 0, "empty ManagedStruct has size 0")
set $P0,1
set $I0,$P0
is($I0, 1, "non-empty ManagedStruct has correct size")
set $P0,2
set $I0,$P0
is($I0, 2, "non-empty ManagedStruct has correct size")
.end
#pasm_output_is( <<'CODE', <<'OUTPUT', "element access - float, double" );
.sub element_access
#element access - float, double
new $P2, ['ResizablePMCArray']
.include "datatypes.pasm"
push $P2, .DATATYPE_FLOAT
push $P2, 2 # 2 elem array
push $P2, 0
push $P2, .DATATYPE_DOUBLE
push $P2, 0
push $P2, 0
new $P0, ['ManagedStruct'], $P2
# must have set size automatically
# this is hopefully 2*4+8 everywhere
set $I0, $P0
is($I0, 16, "ManagedStruct has correct size")
set $P0[0;0], 14.1
set $N0, $P0[0;0]
set $P0[0;1], 14.2
set $P0[1], 14.3
set $N0, $P0[0;0]
sub $N1, $N0, 14.1
cmp $I0, $N1, 0.000001
ok($I0, "stored float has correct value")
set $N0, $P0[0;1]
sub $N1, $N0, 14.2
cmp $I0, $N1, 0.000001
ok($I0, "stored float has correct value")
set $N0, $P0[1]
sub $N1, $N0, 14.3
cmp $I0, $N1, 0.000001
ok($I0, "stored float has correct value")
#element access - char, short
new $P2, ['ResizablePMCArray']
push $P2, .DATATYPE_CHAR
push $P2, 2 # 2 elem char array
push $P2, 0
new $P0, ['ManagedStruct'], $P2
set $I0, $P0
$I1 = isge $I0, 2
ok($I1, "ManagedStruct size is at least 2")
set $P0[0;0], 1
set $P0[0;1], 258 # must be truncated to 2
set $I0, $P0[0;0]
is($I0, 1, "char val of 1 is correct")
set $I0, $P0[0;1]
is($I0, 2, "char val of 258 retrieved as 2")
# now access that as a short
new $P2, ['ResizablePMCArray']
push $P2, .DATATYPE_SHORT
push $P2, 1
push $P2, 0
assign $P0, $P2
# should be 2*256+1 or 1*256+2
set $I0, $P0[0]
$I1 = $I0 == 513
$I2 = $I0 == 258
$I0 = $I1 | $I2
ok($I0, "short val retrieved correctly")
.end
.sub named_element_access_int16
new $P1, ['OrderedHash']
set $P1['x'], .DATATYPE_INT16
push $P1, 0
push $P1, 0
set $P1['y'], .DATATYPE_INTVAL
push $P1, 0
push $P1, 0
# need a ManagedStruct to allocate data memory
new $P2, ['ManagedStruct'], $P1
# set struct values by name
set $I0, 2
set $P2["x"], $I0
set $I1, 16
set $S0, "y"
set $P2[$S0], $I1
# get struct values by struct item idx
set $I2, $P2[0]
set $I3, $P2[1]
is($I2, 2, "'x' value by idx is correct")
is($I3, 16, "'y' value by idx is correct")
# get struct values by name
set $I2, $P2["x"]
set $I3, $P2["y"]
is($I2, 2, "'x' value by name is correct")
is($I3, 16, "'y' value by name is correct")
# try getting a string
push_eh eh
set $S0, $P2["x"]
ok(0, "able to get a DATATYPE_INT16 as string")
goto finally
eh:
.get_results($P3)
is($P3, "returning unhandled string type in struct", "raised correct exception when trying to get DATATYPE_INT16 as string")
finally:
pop_eh
.end
#pasm_output_is( <<'CODE', <<'OUTPUT', "nested struct offsets" );
.sub nested_struct_offsets
# the nested structure
new $P3, ['ResizablePMCArray']
push $P3, .DATATYPE_INT
push $P3, 0
push $P3, 0
push $P3, .DATATYPE_INT
push $P3, 0
push $P3, 0
new $P4, ['UnManagedStruct'], $P3
# outer structure
new $P2, ['ResizablePMCArray']
push $P2, .DATATYPE_INT
push $P2, 0
push $P2, 0
push $P2, .DATATYPE_STRUCT
# attach the unmanged struct as property
set $P1, $P2[-1]
setprop $P1, "_struct", $P4
push $P2, 0
push $P2, 0
push $P2, .DATATYPE_INT
push $P2, 0
push $P2, 0
# attach struct initializer
new $P5, ['UnManagedStruct'], $P2
# now check offsets
set $I0, $P2[2]
is($I0, 0, "offset 2 looks good")
set $I0, $P2[5]
is($I0, 4, "offset 5 looks good")
set $I0, $P2[8]
is($I0, 12, "offset 8 looks good")
# nested
set $I0, $P3[2]
is($I0, 0, "nested offest 2 looks good")
set $I0, $P3[5]
is($I0, 4, "nested offset 5 looks good")
# check struct size
set $I0, $P5
is($I0, 16, "struct size looks good")
# nested
set $I0, $P4
is($I0, 8, "nested struct size looks good")
.end
.sub interface_check
.local pmc pmc1
pmc1 = new ['ManagedStruct']
.local int bool1
does bool1, pmc1, "scalar"
is(bool1, 1, "ManagedStruct does scalar")
does bool1, pmc1, "no_interface"
is(bool1, 0, "ManagedStruct doesn't do no_interface")
.end
.sub destroy_custom
.local pmc pmc1
pmc1 = new ['ManagedStruct']
$P0 = get_global 'test_handler'
# I'm not sure how to set custom_destroy func?
#setattribute pmc1, "custom_free_func", $P0
null pmc1
sweep 1
.end
.sub custom_destroyer
say "ManagedStruct being custom destroyed here"
#ok()
.end
.sub realloc_free
.local pmc pmc1
pmc1 = new ['ManagedStruct']
# Allocate memory for the ms
pmc1 = 1337
# And free is by setting it to zero.
pmc1 = 0
ok(1, "Allocate and free")
.end
# Local Variables:
# mode: pir
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4 ft=pir:
Jump to Line
Something went wrong with that request. Please try again.