Author: autrijus
Date: Sat Mar 11 08:30:21 2006
New Revision: 11861
Added:
trunk/languages/pugs/include/
trunk/languages/pugs/pmc/pugsany.pmc
trunk/languages/pugs/pmc/pugsbit.pmc
trunk/languages/pugs/t/
trunk/languages/pugs/t/harness
trunk/languages/pugs/t/pmc/
trunk/languages/pugs/t/pmc/bit.t (contents, props changed)
Modified:
trunk/MANIFEST
trunk/config/gen/makefiles.pm
trunk/languages/pugs/config/makefiles/root.in
trunk/languages/pugs/pmc/pugsint.pmc
trunk/languages/pugs/pmc/pugsnum.pmc
trunk/languages/pugs/pmc/pugsstr.pmc
Log:
* languages/pugs/: basic value PMCs and some tests.
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST (original)
+++ trunk/MANIFEST Sat Mar 11 08:30:21 2006
@@ -1004,6 +1004,13 @@
languages/lua/t/pmc/table.t [lua]
languages/lua/t/pmc/thread.t [lua]
languages/lua/t/pmc/userdata.t [lua]
+languages/pugs/config/makefiles/root.in [pugs]
+languages/pugs/pmc/pugsany.pmc [pugs]
+languages/pugs/pmc/pugsint.pmc [pugs]
+languages/pugs/pmc/pugsnum.pmc [pugs]
+languages/pugs/pmc/pugsstr.pmc [pugs]
+languages/pugs/include/pugs_common.h [pugs]
+languages/pugs/t/pmc/bit.t [pugs]
languages/m4/BUGS [m4]
languages/m4/ChangeLog [m4]
languages/m4/INSTALL [m4]
Modified: trunk/config/gen/makefiles.pm
==============================================================================
--- trunk/config/gen/makefiles.pm (original)
+++ trunk/config/gen/makefiles.pm Sat Mar 11 08:30:21 2006
@@ -161,6 +161,12 @@
conditioned_lines => 1
);
genfile(
+ 'languages/pugs/config/makefiles/root.in' => 'languages/pugs/Makefile',
+ commentType => '#',
+ replace_slashes => 1,
+ conditioned_lines => 1
+ );
+ genfile(
'config/gen/makefiles/miniperl.in' => 'languages/miniperl/Makefile',
commentType => '#',
replace_slashes => 1
Modified: trunk/languages/pugs/config/makefiles/root.in
==============================================================================
--- trunk/languages/pugs/config/makefiles/root.in (original)
+++ trunk/languages/pugs/config/makefiles/root.in Sat Mar 11 08:30:21 2006
@@ -1,90 +1,51 @@
-RM_F = @rm_f@
-PERL = @perl@
-PARROT = [EMAIL PROTECTED]@[EMAIL PROTECTED]@[EMAIL PROTECTED]@
-PBC_MERGE = [EMAIL PROTECTED]@[EMAIL PROTECTED]@[EMAIL PROTECTED]@
-
-LIBPATH = lib
-BUILD = $(PERL) @build_dir@@[EMAIL PROTECTED]@[EMAIL PROTECTED]@[EMAIL
PROTECTED]
-DESTDIR = @build_dir@@[EMAIL PROTECTED]@[EMAIL PROTECTED]@[EMAIL PROTECTED]
-O = @o@
-CLASSDIR = pmc
-LOAD_EXT = @load_ext@
-
-PMCS = \
- luabase \
- luaboolean \
- luafunction \
- luanil \
- luanumber \
- luastring \
- luatable \
- luathread \
- luauserdata
-
-PBCS = \
- $(LIBPATH)@[EMAIL PROTECTED] \
- $(LIBPATH)@[EMAIL PROTECTED] \
- $(LIBPATH)@[EMAIL PROTECTED] \
- $(LIBPATH)@[EMAIL PROTECTED] \
- $(LIBPATH)@[EMAIL PROTECTED] \
- $(LIBPATH)@[EMAIL PROTECTED] \
- $(LIBPATH)@[EMAIL PROTECTED] \
- $(LIBPATH)@[EMAIL PROTECTED]
-
-all: pmcs $(PBCS) [EMAIL PROTECTED]@parser.pm
-
-pmcs:
- @cd $(CLASSDIR) && $(BUILD) generate $(PMCS)
- @cd $(CLASSDIR) && $(BUILD) compile $(PMCS)
- @cd $(CLASSDIR) && $(BUILD) linklibs $(PMCS)
- @cd $(CLASSDIR) && $(BUILD) copy "--destination=$(DESTDIR)" $(PMCS)
-
-$(LIBPATH)@[EMAIL PROTECTED]: $(LIBPATH)@[EMAIL PROTECTED]
- $(PARROT) --output=$(LIBPATH)@[EMAIL PROTECTED] $(LIBPATH)@[EMAIL
PROTECTED]
-
-$(LIBPATH)@[EMAIL PROTECTED]: $(LIBPATH)@[EMAIL PROTECTED]
- $(PARROT) --output=$(LIBPATH)@[EMAIL PROTECTED] $(LIBPATH)@[EMAIL
PROTECTED]
-
-$(LIBPATH)@[EMAIL PROTECTED]: $(LIBPATH)@[EMAIL PROTECTED]
- $(PARROT) --output=$(LIBPATH)@[EMAIL PROTECTED] $(LIBPATH)@[EMAIL
PROTECTED]
-
-$(LIBPATH)@[EMAIL PROTECTED]: $(LIBPATH)@[EMAIL PROTECTED]
- $(PARROT) --output=$(LIBPATH)@[EMAIL PROTECTED] $(LIBPATH)@[EMAIL
PROTECTED]
-
-$(LIBPATH)@[EMAIL PROTECTED]: $(LIBPATH)@[EMAIL PROTECTED]
- $(PARROT) --output=$(LIBPATH)@[EMAIL PROTECTED] $(LIBPATH)@[EMAIL
PROTECTED]
-
-$(LIBPATH)@[EMAIL PROTECTED]: $(LIBPATH)@[EMAIL PROTECTED]
- $(PARROT) --output=$(LIBPATH)@[EMAIL PROTECTED] $(LIBPATH)@[EMAIL
PROTECTED]
-
-$(LIBPATH)@[EMAIL PROTECTED]: $(LIBPATH)@[EMAIL PROTECTED]
- $(PARROT) --output=$(LIBPATH)@[EMAIL PROTECTED] $(LIBPATH)@[EMAIL
PROTECTED]
-
-$(LIBPATH)@[EMAIL PROTECTED]: $(LIBPATH)@[EMAIL PROTECTED]
- $(PARROT) --output=$(LIBPATH)@[EMAIL PROTECTED] $(LIBPATH)@[EMAIL
PROTECTED]
-
[EMAIL PROTECTED]@parser.pm: [EMAIL PROTECTED]@lua51.yp
- yapp -s -v -m Lua::parser -o Lua/parser.pm Lua/lua51.yp
-
-test:
- cd .. && $(PERL) -I../lib -Ilua/t lua/t/harness
-
-CLEANERS = \
-"t/lib/*.pir" \
-"t/pmc/*.pir" \
-"t/*.pir" \
-"t/*.lua" \
-"t/*.orig_out" \
-"t/*.parrot_out" \
-"$(CLASSDIR)/*.dump" \
-"$(CLASSDIR)/*.c" \
-"$(CLASSDIR)/*.h" \
-"$(CLASSDIR)/*$(LOAD_EXT)" \
-"$(CLASSDIR)/*$(O)" \
-"$(LIBPATH)/*.pbc"
-
-clean:
- $(RM_F) $(CLEANERS)
-
-distclean: clean
- $(RM_F) Makefile
+RM_F = @rm_f@
+PERL = @perl@
+PARROT = [EMAIL PROTECTED]@[EMAIL PROTECTED]@[EMAIL PROTECTED]@
+PBC_MERGE = [EMAIL PROTECTED]@[EMAIL PROTECTED]@[EMAIL PROTECTED]@
+
+LIBPATH = lib
+BUILD = $(PERL) @build_dir@@[EMAIL PROTECTED]@[EMAIL PROTECTED]@[EMAIL
PROTECTED]
+DESTDIR = @build_dir@@[EMAIL PROTECTED]@[EMAIL PROTECTED]@[EMAIL PROTECTED]
+O = @o@
+CLASSDIR = pmc
+LOAD_EXT = @load_ext@
+
+PMCS = \
+ pugsany \
+ pugsbit \
+ pugsint \
+ pugsnum \
+ pugsstr
+
+PBCS =
+
+all: pmcs $(PBCS)
+
+pmcs:
+ @cd $(CLASSDIR) && $(BUILD) generate $(PMCS)
+ @cd $(CLASSDIR) && $(BUILD) compile $(PMCS)
+ @cd $(CLASSDIR) && $(BUILD) linklibs $(PMCS)
+ @cd $(CLASSDIR) && $(BUILD) copy "--destination=$(DESTDIR)" $(PMCS)
+
+test:
+ cd .. && $(PERL) -I../lib -Ipugs/t pugs/t/harness
+
+CLEANERS = \
+"t/lib/*.pir" \
+"t/pmc/*.pir" \
+"t/*.pir" \
+"t/*.p6" \
+"t/*.orig_out" \
+"t/*.parrot_out" \
+"$(CLASSDIR)/*.dump" \
+"$(CLASSDIR)/*.c" \
+"$(CLASSDIR)/*.h" \
+"$(CLASSDIR)/*$(LOAD_EXT)" \
+"$(CLASSDIR)/*$(O)" \
+"$(LIBPATH)/*.pbc"
+
+clean:
+ $(RM_F) $(CLEANERS)
+
+distclean: clean
+ $(RM_F) Makefile
Added: trunk/languages/pugs/pmc/pugsany.pmc
==============================================================================
--- (empty file)
+++ trunk/languages/pugs/pmc/pugsany.pmc Sat Mar 11 08:30:21 2006
@@ -0,0 +1,34 @@
+/*
+Copyright: 2006 The Perl Foundation. All Rights Reserved.
+$Id: luabase.pmc 11478 2006-02-09 08:26:19Z fperrad $
+
+=head1 NAME
+
+pugsany.pmc - Pugs Abstract Base Class
+
+=head1 DESCRIPTION
+
+C<PugsAny> provides an abstract base class for both Pugs Values and References.
+
+=head2 Methods
+
+=over 4
+
+=cut
+
+*/
+
+#include "parrot/parrot.h"
+#include "../include/pugs_common.h"
+
+pmclass PugsAny
+ abstract
+ dynpmc
+ group pugs_group
+ hll Perl6 {
+
+ METHOD PMC* not_nil() {
+ INTVAL retval = VTABLE_defined(INTERP, SELF);
+ return retval ? pugs_bit_true : pugs_bit_false;
+ }
+}
Added: trunk/languages/pugs/pmc/pugsbit.pmc
==============================================================================
--- (empty file)
+++ trunk/languages/pugs/pmc/pugsbit.pmc Sat Mar 11 08:30:21 2006
@@ -0,0 +1,62 @@
+/*
+Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
+$Id: /mirror/trunk/languages/pugs/pmc/pugsbit.pmc 11860
2006-03-11T15:14:44.630439Z autrijus $
+
+=head1 NAME
+
+src/pmc/perlbit.pmc - Perl Bit
+
+=head1 DESCRIPTION
+
+C<PugsInt> extends C<Bit> to provide a Perl 6 biteger.
+
+=head2 Methods
+
+=over 4
+
+=cut
+
+*/
+
+#include "parrot/parrot.h"
+#include "pmc_pugsbit.h"
+
+static PMC *pugs_bit_true;
+static PMC *pugs_bit_false;
+
+pmclass PugsBit
+ extends Boolean
+ does scalar
+ does boolean
+ does integer
+ dynpmc
+ group pugs_group
+ hll Perl6
+ maps Boolean
+{
+ void class_init() {
+ Parrot_PugsBase_super_init(INTERP, NULL);
+ /* generate a PugsBitTrue and a PugsBitFalse here */
+ pugs_bit_true = pmc_new(interp, entry);
+ pugs_bit_false = pmc_new(interp, entry);
+ VTABLE_set_integer_native(interp, pugs_bit_true, 1);
+ }
+}
+
+/*
+
+=back
+
+=cut
+
+*/
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * vim: expandtab shiftwidth=4:
+*/
Modified: trunk/languages/pugs/pmc/pugsint.pmc
==============================================================================
--- trunk/languages/pugs/pmc/pugsint.pmc (original)
+++ trunk/languages/pugs/pmc/pugsint.pmc Sat Mar 11 08:30:21 2006
@@ -1,14 +1,14 @@
/*
-Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
+Copyright: 2006 The Perl Foundation. All Rights Reserved.
$Id$
=head1 NAME
-src/pmc/perlint.pmc - Perl Integer
+pugsint.pmc - Pugs Integer
=head1 DESCRIPTION
-C<PerlInt> extends C<Integer> to provide a Perl integer.
+C<PugsInt> extends C<Integer> to provide a Perl 6 C<Int>.
=head2 Methods
@@ -20,54 +20,17 @@
#include "parrot/parrot.h"
-void Parrot_perlscalar_morph(Interp* , PMC* pmc, INTVAL type);
-
-/* TODO extends PerlAny or perlscalar or whatever */
-pmclass PerlInt extends Integer does integer does scalar {
-
-
-/*
-
-=item C<void set_number_native(FLOATVAL value)>
-
-Morphs the integer to a C<PerlNum> and sets the value from C<value>.
-
-=cut
-
-*/
- void set_number_native (FLOATVAL value) {
- DYNSELF.morph(enum_class_PerlNum);
- DYNSELF.set_number_native(value);
- }
-
-
-/*
-
-=item C<void set_string_native(STRING *value)>
-
-Sets the value of the integer to C<*value>.
-
-=cut
-
-*/
- void set_string_native (STRING* value) {
- DYNSELF.morph(enum_class_PerlString);
- DYNSELF.set_string_native(value);
- }
-
-/*
-
-=item C<void morph(INTVAL type)>
-
-Morphs the scalar to the specified type.
-
-=cut
-
-*/
-
- void morph (INTVAL type) {
- perlscalar.SELF.morph(type);
- }
+pmclass PugsInt
+ extends Integer
+ extends PugsAny
+ does scalar
+ does integer
+ dynpmc
+ group pugs_group
+ hll Perl6
+ maps Integer
+{
+ /* zero lines of code! whee! */
}
/*
Modified: trunk/languages/pugs/pmc/pugsnum.pmc
==============================================================================
--- trunk/languages/pugs/pmc/pugsnum.pmc (original)
+++ trunk/languages/pugs/pmc/pugsnum.pmc Sat Mar 11 08:30:21 2006
@@ -4,11 +4,11 @@
=head1 NAME
-src/pmc/perlnum.pmc - Perl Floating-Point Number
+pugsnum.pmc - Pugs Number
=head1 DESCRIPTION
-These are the vtable functions for the PerlNum base class
+C<PugsNum> extends C<Number> to provide a Perl 6 C<Num>.
=head2 Methods
@@ -20,102 +20,17 @@
#include "parrot/parrot.h"
-void Parrot_perlscalar_morph(Interp* , PMC* pmc, INTVAL type);
-
-pmclass PerlNum extends Float does float does scalar {
-
-/*
-
-=item C<STRING *get_string()>
-
-Returns the number as a Parrot string.
-
-=cut
-
-*/
-
- STRING* get_string () {
-#if 0
- double d = (double) PMC_num_val(SELF);
- const char *sign = "-";
- if (!signbit(PMC_num_val(SELF)))
- sign = "";
- d = fabs(d);
- return Parrot_sprintf_c(INTERP, "%s" FLOATVAL_FMT, sign, d);
-#else
- /* XXX signbit isn't portable and as we are calling Parrot_sprintf_c
- * anyway, we can use the builtin number formatting too
- * this might still be a problem with -0.0
- */
- return Parrot_sprintf_c(INTERP, "%Pf", SELF);
-#endif
- }
-
-
-/*
-
-=item C<void set_integer_native(INTVAL value)>
-
-=cut
-
-*/
-
- void set_integer_native (INTVAL value) {
- DYNSELF.morph(enum_class_PerlInt);
- DYNSELF.set_integer_native(value);
- }
-
-/*
-
-=item C<void set_number_native(FLOATVAL value)>
-
-Sets the value of the number to C<value>.
-
-Note that if C<value> is an integer the number morphs to a C<PerlInt>.
-
-=cut
-
-*/
-
- void set_number_native (FLOATVAL value) {
- INTVAL vali = (INTVAL) value;
-
- PMC_num_val(SELF) = value;
- /* don't mess around with - 0 */
- if (value == vali && (vali || !Parrot_signbit(value)))
- DYNSELF.set_integer_native(vali);
- }
-
-/*
-
-=item C<void set_string_native(STRING *value)>
-
-Sets the value of the number to the value of C<*value>.
-
-Note that this method morphs the number into a C<PerlString>.
-
-=cut
-
-*/
-
- void set_string_native (STRING * value) {
- DYNSELF.morph(enum_class_PerlString);
- DYNSELF.set_string_native(value);
- }
-
-/*
-
-=item C<void morph(INTVAL type)>
-
-Morphs the scalar to the specified type.
-
-=cut
-
-*/
-
- void morph (INTVAL type) {
- perlscalar.SELF.morph(type);
- }
+pmclass PugsNum
+ extends Float
+ extends PugsAny
+ does scalar
+ does float
+ dynpmc
+ group pugs_group
+ hll Perl6
+ maps Float
+{
+ /* zero lines of code! whee! */
}
/*
@@ -135,4 +50,3 @@
*
* vim: expandtab shiftwidth=4:
*/
-
Modified: trunk/languages/pugs/pmc/pugsstr.pmc
==============================================================================
--- trunk/languages/pugs/pmc/pugsstr.pmc (original)
+++ trunk/languages/pugs/pmc/pugsstr.pmc Sat Mar 11 08:30:21 2006
@@ -1,16 +1,14 @@
/*
-Copyright: 2001-2005 The Perl Foundation. All Rights Reserved.
+Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
$Id$
=head1 NAME
-src/pmc/perlstring.pmc - Perl String
+pugsstr.pmc - Pugs String
=head1 DESCRIPTION
-C<PerlString> extends C<String> to provide Perl-specific string behaviour.
-Note that the C<morph> method comes from C<PerlScalar>,
-not from C<String>.
+C<PugsStr> extends C<String> to provide a Perl 6 C<Str>.
=head2 Methods
@@ -22,138 +20,17 @@
#include "parrot/parrot.h"
-void Parrot_perlscalar_morph(Interp* , PMC* pmc, INTVAL type);
-
-pmclass PerlString extends String does string does scalar {
-
-/*
-
-=item C<INTVAL get_integer()>
-
-Returns the integer representation of the string by converting to float first.
-See t/pmc/perlstring_13 set P0, "1.23e2" ; set I0, P0
-
-=cut
-
-*/
- INTVAL get_integer () {
- double f = DYNSELF.get_number();
- return (INTVAL)f;
- }
-
-/*
-
-=item C<STRING* get_repr()>
-
-Returns pythons string repr (w/o any escaping, just single quotes around)
-
-=cut
-
-*/
-
- STRING* get_repr() {
- STRING *start, *s, *q, *repr;
- q = const_string(INTERP, "'");
- s = DYNSELF.get_string();
- if (PObj_get_FLAGS(s) & PObj_private7_FLAG)
- start = const_string(INTERP, "u'");
- else
- start = q;
- repr = string_copy(INTERP, start);
- repr = string_append(INTERP, repr, s, 0);
- repr = string_append(INTERP, repr, q, 0);
- return repr;
- }
-
-/*
-
-=item C<void set_integer_native(INTVAL value)>
-
-Morphs the string to a C<PerlInt> and sets its value to C<value>.
-
-=cut
-
-*/
-
- void set_integer_native (INTVAL value) {
- DYNSELF.morph(enum_class_PerlInt);
- DYNSELF.set_integer_native(value);
- }
-
-/*
-
-=item C<void set_number_native(FLOATVAL value)>
-
-Morphs the string to a C<PerlNum> and sets its value to C<value>.
-
-=cut
-
-*/
-
- void set_number_native (FLOATVAL value) {
- DYNSELF.morph(enum_class_PerlNum);
- DYNSELF.set_number_native(value);
- }
-
-/*
-
-=item C<void morph(INTVAL type)>
-
-Morphs the C<PerlString> to the specified type.
-
-=cut
-
-*/
-
- void morph (INTVAL type) {
- perlscalar.SELF.morph(type);
- }
-
-/*
-
-=item C<void increment()>
-
-=item C<void decrement()>
-
-These two methods are partially implemented. They should provide
-Perl 5 like string increment/decrement.
-
-=cut
-
-*/
-
- void increment () {
- STRING* s = PMC_str_val(SELF);
- PMC_str_val(SELF) = string_increment(INTERP, s);
- }
-
- void decrement () {
- INTVAL i = VTABLE_get_integer(INTERP, SELF);
- VTABLE_set_integer_native(INTERP, SELF, i - 1);
- }
-
-
-/*
-
-=item C<PMC *get_pmc_keyed(PMC *key)>
-
-Returns the string value for C<SELF[key]>.
-
-=cut
-
-*/
-
- PMC* get_pmc_keyed(PMC* key) {
- STRING *s = PMC_str_val(SELF);
- PMC *ret;
-
- ret = pmc_new_noinit(INTERP, enum_class_PerlString);
- PMC_str_val(ret) = string_substr(INTERP, s,
- key_integer(INTERP,key), 1, NULL, 0);
- PObj_custom_mark_SET(ret);
- return ret;
- }
-
+pmclass PugsStr
+ extends String
+ extends PugsAny
+ does scalar
+ does string
+ dynpmc
+ group pugs_group
+ hll Perl6
+ maps String
+{
+ /* zero lines of code! whee! */
}
/*
Added: trunk/languages/pugs/t/harness
==============================================================================
--- (empty file)
+++ trunk/languages/pugs/t/harness Sat Mar 11 08:30:21 2006
@@ -0,0 +1,108 @@
+# Copyright: 2005 The Perl Foundation. All Rights Reserved.
+# $Id: /mirror/trunk/languages/lua/t/harness 11501 2006-02-10T18:27:13.457666Z
particle $
+
+=head1 NAME
+
+languages/lua/t/harness - A harness for Parrot Lua
+
+=head1 SYNOPSIS
+
+ cd languages && perl -I../lib -Ilua/t lua/t/harness --files
+
+ cd languages && perl -I../lib -Ilua/t lua/t/harness
+
+ cd languages && perl -I../lib -Ilua/t lua/t/harness lua/t/examples.t
+
+ cd languages && perl -I../lib lua/t/harness lua/t/pmc/nil.t
+
+=head1 DESCRIPTION
+
+If I'm called with a single
+argument of "--files", I just return a list of files to process.
+This list is one per line, and is relative to the languages dir.
+
+If I'm called with no args, I run the complete suite.
+
+If I'm called with "--use-lua", I run with the original C<lua>
+in order to valid of the test suite.
+
+If I'm called with "--use-monkey", I run with C<monkey>.
+
+If I'm called with "--use-lua2pir", I run with C<lua2pir> (and just after
+C<luac>).
+
+Otherwise I run the tests that were passed on the command line.
+
+=cut
+
+use strict;
+use lib '..';
+
+use Cwd();
+use Data::Dumper;
+use File::Spec;
+use Test::Harness();
+
+my $language = 'lua';
+
+if ( grep { m/^--files$/ } @ARGV ) {
+ # Only the Makefile in 'parrot/languages' uses --files
+ my $dir = File::Spec->catfile( $language, 't' );
+ my @files = glob( File::Spec->catfile( $dir, '*.t' ) );
+ push @files, glob( File::Spec->catfile( $dir, '*/*.t' ) );
+ print join( "\n", @files );
+ print "\n" if scalar(@files);
+} else {
+ my @files;
+ # TODO: use Getopt::Long or such
+ my $use_orig_lua = ( grep { m/^--use-lua$/ } @ARGV ) ? 1 : 0;
+ my $use_monkey = ( grep { m/^--use-monkey$/ } @ARGV ) ? 1 : 0;
+ my $use_lua2pir = ( grep { m/^--use-lua2pir$/ } @ARGV ) ? 1 : 0;
+ @ARGV = grep { ! m/^--use-lua$/ } @ARGV;
+ @ARGV = grep { ! m/^--use-monkey$/ } @ARGV;
+ @ARGV = grep { ! m/^--use-lua2pir$/ } @ARGV;
+ if ( scalar(@ARGV) ) {
+ # Someone specified tests for me to run.
+ @files = grep { -f $_ } @ARGV
+ } else {
+ ( undef, undef, my $current_dir ) = File::Spec->splitpath(
Cwd::getcwd() );
+ if ( $current_dir eq 'languages' ) {
+ @files = glob( File::Spec->catfile( $language, 't', '*.t' ) );
+ push @files, glob( File::Spec->catfile( $language, 't', '*', '*.t'
) )
+ unless ( $use_orig_lua );
+ }
+ elsif ( $current_dir eq $language ) {
+ @files = glob( File::Spec->catfile( 't', '*.t' ) );
+ push @files, glob( File::Spec->catfile( 't', '*', '*.t' ) )
+ unless ( $use_orig_lua );
+ }
+ }
+
+ if ( $use_orig_lua ) {
+ $ENV{PARROT_LUA_TEST_PROG} = 'lua';
+ Test::Harness::runtests( @files ) if scalar( @files );
+ } elsif ( $use_monkey ) {
+ $ENV{PARROT_LUA_TEST_PROG} = 'monkey';
+ Test::Harness::runtests( @files ) if scalar( @files );
+ } elsif ( $use_lua2pir ) {
+ $ENV{PARROT_LUA_TEST_PROG} = 'lua2pir';
+ Test::Harness::runtests( @files ) if scalar( @files );
+ } else {
+ $ENV{PARROT_LUA_TEST_PROG} = '';
+ Test::Harness::runtests( @files ) if scalar( @files );
+ }
+}
+
+=head1 HISTORY
+
+Mostly taken from F<languages/bc/t/harness>.
+
+=head1 SEE ALSO
+
+F<languages/tcl/t/harness>, F<languages/scheme/t/harness>,
F<languages/m4/t/harness>, F<languages/python/t/harness>
+
+=head1 AUTHOR
+
+Francois Perrad
+
+=cut
Added: trunk/languages/pugs/t/pmc/bit.t
==============================================================================
--- (empty file)
+++ trunk/languages/pugs/t/pmc/bit.t Sat Mar 11 08:30:21 2006
@@ -0,0 +1,30 @@
+#! perl -w
+# Copyright: 2005-2006 The Perl Foundation. All Rights Reserved.
+# $Id: /mirror/trunk/languages/lua/t/pmc/boolean.t 11586
2006-02-16T17:44:54.559622Z fperrad $
+
+=head1 NAME
+
+t/pmc/bit.t - PugsBit
+
+=head1 SYNOPSIS
+
+ % perl -I../../lib t/pmc/bit.t
+
+=cut
+
+use Parrot::Test 'no_plan';
+use Test::More;
+
+pir_output_is(<< 'CODE', << 'OUTPUT', "check sanity");
+.HLL "Perl6", "pugs_group"
+.sub _main
+ loadlib P1, "pugs_group"
+ find_type $I0, "PugsBit"
+ .local pmc pmc1
+ pmc1 = new $I0
+ print "ok\n"
+.end
+CODE
+ok
+OUTPUT
+