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

+

Reply via email to