Skip to content
This repository has been archived by the owner on Jun 9, 2018. It is now read-only.

Commit

Permalink
Browse files Browse the repository at this point in the history
rewrite in PIR
  • Loading branch information
fperrad committed Sep 4, 2009
1 parent f72e19c commit 7800a1f
Show file tree
Hide file tree
Showing 10 changed files with 746 additions and 1,080 deletions.
257 changes: 61 additions & 196 deletions t/pmc/boolean.t
@@ -1,12 +1,12 @@
#! perl
# Copyright (C) 2006-2009, Parrot Foundation.
#!parrot
# Copyright (C) 2009, Parrot Foundation.
# $Id$

=head1 WmlsBoolean

=head2 Synopsis

% perl t/pmc/boolean.t
% perl t/harness t/pmc/boolean.t

=head2 Description

Expand All @@ -15,208 +15,73 @@ Tests C<WmlsBoolean> PMC

=cut

use strict;
use warnings;
use FindBin;
use lib "$FindBin::Bin/../../../../lib";

use Parrot::Test tests => 9;
use Test::More;

pir_output_is( << 'CODE', << 'OUTPUT', 'check inheritance' );
.sub _main
loadlib $P1, "wmls_group"
.local pmc pmc1
pmc1 = new "WmlsBoolean"
.local int bool1
bool1 = isa pmc1, "Boolean"
print bool1
print "\n"
bool1 = isa pmc1, "WmlsBoolean"
print bool1
print "\n"
end
.end
CODE
1
1
OUTPUT

pir_output_is( << 'CODE', << 'OUTPUT', 'check interface' );
.sub _main
loadlib $P1, "wmls_group"
.local pmc pmc1
pmc1 = new "WmlsBoolean"
.local int bool1
bool1 = does pmc1, "scalar"
print bool1
print "\n"
bool1 = does pmc1, "boolean"
print bool1
print "\n"
bool1 = does pmc1, "integer"
print bool1
print "\n"
bool1 = does pmc1, "no_interface"
print bool1
print "\n"
end
.end
CODE
1
1
1
0
OUTPUT

pir_output_is( << 'CODE', << 'OUTPUT', 'check name' );
.sub _main
loadlib $P1, "wmls_group"
.local pmc pmc1
pmc1 = new "WmlsBoolean"
.local string str1
str1 = typeof pmc1
print str1
print "\n"
end
.end
CODE
WmlsBoolean
OUTPUT

pir_output_is( << 'CODE', << 'OUTPUT', 'check get_string' );
.sub _main
loadlib $P1, "wmls_group"
.local pmc pmc1
pmc1 = new "WmlsBoolean"
pmc1 = 0
print pmc1
print "\n"
pmc1 = 1
print pmc1
print "\n"
end

.sub 'main' :main
loadlib $P0, 'wmls_group'

.include 'test_more.pir'

plan(12)

check_inheritance()
check_interface()
check_name()
check_get_string()
check_clone()
.end
CODE
false
true
OUTPUT

pir_output_is( << 'CODE', << 'OUTPUT', 'check clone' );
.sub _main
loadlib $P1, "wmls_group"
.local pmc pmc1
pmc1 = new "WmlsBoolean"
pmc1 = 1
.local pmc pmc2
pmc2 = clone pmc1
pmc1 = 0
.local string str1
str1 = typeof pmc2
print str1
print "\n"
.local string str2
str2 = pmc2
print str2
print "\n"
str1 = pmc1
print str1
print "\n"
end

.sub 'check_inheritance'
$P0 = new 'WmlsBoolean'
$I0 = isa $P0, 'Boolean'
is($I0, 1)
$I0 = isa $P0, 'WmlsBoolean'
is($I0, 1)
.end
CODE
WmlsBoolean
true
false
OUTPUT

pir_output_is( << 'CODE', << 'OUTPUT', 'check HLL' );
.HLL "wmlscript"
.loadlib "wmls_group"
.sub _main
.local pmc pmc1
pmc1 = new "WmlsBoolean"
pmc1 = 1
print pmc1
print "\n"
.local int bool1
bool1 = isa pmc1, "WmlsBoolean"
print bool1
print "\n"
end

.sub 'check_interface'
$P0 = new 'WmlsBoolean'
$I0 = does $P0, 'scalar'
is($I0, 1)
$I0 = does $P0, 'boolean'
is($I0, 1)
$I0 = does $P0, 'integer'
is($I0, 1)
$I0 = does $P0, 'no_interface'
is($I0, 0)
.end
CODE
true
1
OUTPUT

pir_output_is( << 'CODE', << 'OUTPUT', 'check istrue' );
.HLL "wmlscript"
.loadlib "wmls_group"
.loadlib "wmls_ops"
.sub _main
.const "WmlsBoolean" cst1 = "1"
print cst1
print "\n"
$P0 = istrue cst1
print $P0
print "\n"

.sub 'check_name'
$P0 = new 'WmlsBoolean'
$S0 = typeof $P0
print $S0
print "\n"
is($S0, 'WmlsBoolean')
.end
CODE
true
true
WmlsBoolean
OUTPUT

pir_output_is( << 'CODE', << 'OUTPUT', 'check typeof' );
.HLL "wmlscript"
.loadlib "wmls_group"
.loadlib "wmls_ops"
.sub _main
.const "WmlsBoolean" cst1 = "1"
print cst1
print "\n"
$P0 = typeof cst1
print $P0
print "\n"
$S0 = typeof $P0
print $S0
print "\n"

.sub 'check_get_string'
$P0 = new 'WmlsBoolean'
set $P0, 0
$S0 = $P0
is($S0, 'false')
set $P0, 1
$S0 = $P0
is($S0, 'true')
.end
CODE
true
3
WmlsInteger
OUTPUT

pir_output_is( << 'CODE', << 'OUTPUT', 'check defined' );
.HLL "wmlscript"
.loadlib "wmls_group"
.loadlib "wmls_ops"
.sub _main
.const "WmlsBoolean" cst1 = "1"
print cst1
print "\n"
$P0 = defined cst1
print $P0
print "\n"
$S0 = typeof $P0
print $S0
print "\n"

.sub 'check_clone'
$P0 = new 'WmlsBoolean'
set $P0, 1
$P1 = clone $P0
set $P0, 0
$S0 = typeof $P1
is($S0, 'WmlsBoolean')
$S0 = $P1
is($S0, 'true')
$S0 = $P0
is($S0, 'false')
.end
CODE
true
true
WmlsBoolean
OUTPUT

# Local Variables:
# mode: cperl
# mode: pir
# cperl-indent-level: 4
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4:

# vim: expandtab shiftwidth=4 ft=pir:
81 changes: 81 additions & 0 deletions t/pmc/boolean_hll.t
@@ -0,0 +1,81 @@
#!parrot
# Copyright (C) 2009, Parrot Foundation.
# $Id$

=head1 WmlsBoolean

=head2 Synopsis

% perl t/harness t/pmc/boolean_hll.t

=head2 Description

Tests C<WmlsBoolean> PMC
(implemented in F<languages/WMLScript/pmc/wmlsboolean.pmc>).

=cut

.HLL 'wmlscript'
.loadlib 'wmls_group'
.loadlib 'wmls_ops'

.sub 'main' :main
.include 'test_more.pir'

plan(11)

check_HLL()
check_istrue()
check_typeof()
check_defined()
.end

.sub 'check_HLL'
$P0 = new 'WmlsBoolean'
set $P0, 1
$S0 = $P0
is($S0, 'true')
$I0 = isa $P0, 'WmlsBoolean'
is($I0, 1)
.end

.sub 'check_istrue'
.const 'WmlsBoolean' K = '1'
$S0 = K
is($S0, 'true')
$P0 = istrue K
$S0 = $P0
is($S0, 'true')
$S0 = typeof $P0
is($S0, 'WmlsBoolean')
.end

.sub 'check_typeof'
.const 'WmlsBoolean' K = '1'
$S0 = K
is($S0, 'true')
$P0 = typeof K
$S0 = $P0
is($S0, 3)
$S0 = typeof $P0
is($S0, 'WmlsInteger')
.end

.sub 'check_defined'
.const 'WmlsBoolean' K = '1'
$S0 = K
is($S0, 'true')
$P0 = defined K
$S0 = $P0
is($S0, 'true')
$S0 = typeof $P0
is($S0, 'WmlsBoolean')
.end

# Local Variables:
# mode: pir
# cperl-indent-level: 4
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4 ft=pir:

0 comments on commit 7800a1f

Please sign in to comment.