cvsuser 04/07/10 00:14:15
Modified: config/gen/makefiles m4.in
config/init data.pl
languages/m4 ChangeLog
languages/m4/doc features.pod running.pod
languages/m4/examples eval.imc
languages/m4/src builtin.imc eval.c input.imc m4.imc
languages/m4/t/basic 003_getopt.t 012_eval.t
languages/m4/t/builtins 011_eval.t
languages/m4/t harness
languages/m4/t/regex 003_two_compiles.t
lib/Parrot/Test m4.pm
runtime/parrot/library/Getopt Long.imc
Log:
[perl #30613] [PATCH] Parrot m4 0.0.7
this is just a minor update of Parrot m4. There are no new features.
Thanks to Andy Dougherty there are some build patches, see ticket No.30320.
The tests are at least on my machine completing successfully again.
The temporary files of the tests are written below 'm4/t' again. There are
now some more tests of the builtin macro 'eval'.
Courtesy of Bernhard Schmalhofer <[EMAIL PROTECTED]>
Revision Changes Path
1.6 +30 -19 parrot/config/gen/makefiles/m4.in
Index: m4.in
===================================================================
RCS file: /cvs/public/parrot/config/gen/makefiles/m4.in,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- m4.in 3 Jun 2004 07:35:14 -0000 1.5
+++ m4.in 10 Jul 2004 07:13:39 -0000 1.6
@@ -1,4 +1,4 @@
-# $Id: m4.in,v 1.5 2004/06/03 07:35:14 leo Exp $
+# $Id: m4.in,v 1.6 2004/07/10 07:13:39 leo Exp $
# Setup of some commands
LN_SF = ln -s -f
@@ -6,6 +6,22 @@
PERL = ${perl}
RM_RF = ${rm_rf}
+# Compile commands and flags
+CC = ${cc}
+CFLAGS = ${ccflags} -I../../include
+CC_SHARED = ${cc_shared} # e.g. -fpic
+DEBUG = ${cc_debug}
+WARN = ${ccwarn}
+
+# Linker command and flags
+LINK = ${link}
+LINKFLAGS = ${linkflags}
+
+# Shared-library building
+LD = ${ld}
+LDFLAGS = ${ldflags}
+LD_SHARED = ${ld_shared} # e.g. -shared
+
# some constants
M4_EVAL_COMPILER_SO = ../../runtime/parrot/dynext/m4_eval_compiler.so
@@ -32,13 +48,11 @@
@echo ""
test: build
- cd ..; $(PERL) -I../lib m4/t/harness
-
-build: blib runtime $(M4_EVAL_COMPILER_SO) m4.pbc
+ cd .. && $(PERL) -I../lib m4/t/harness
-blib:
- $(LN_SF) ../../blib
+build: runtime $(M4_EVAL_COMPILER_SO) m4.pbc
+# TODO: get rid of this, as soon as _PARROTLIB is the default
runtime:
$(LN_SF) ../../runtime
@@ -46,7 +60,9 @@
$(LN_SF) src/m4.pbc
$(M4_EVAL_COMPILER_SO): src/eval.c
- $(CC) -shared -fpic src/eval.c -o $@ -g -Wall -I../../include
+ $(CC) $(CFLAGS) $(CC_SHARED) $(DEBUG) $(WARN) -c $<
+ $(LD) $(LD_SHARED) $(LDFLAGS) -o $@ eval.o
+
src/m4.imc: src/builtin.imc src/freeze.imc src/input.imc src/macro.imc
touch $@
@@ -57,8 +73,7 @@
clean:
$(RM_RF) \
-*.pbc \
-blib \
+m4.pbc \
runtime \
src/*.pbc \
src/*/*.pbc \
@@ -77,7 +92,3 @@
%.pbc: %.imc
$(PARROT) -o $@ $<
-
-distclean: clean
-
-.PRECIOUS: %.imc
1.31 +4 -1 parrot/config/init/data.pl
Index: data.pl
===================================================================
RCS file: /cvs/public/parrot/config/init/data.pl,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -w -r1.30 -r1.31
--- data.pl 1 Jul 2004 20:37:04 -0000 1.30
+++ data.pl 10 Jul 2004 07:13:43 -0000 1.31
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: data.pl,v 1.30 2004/07/01 20:37:04 boemmels Exp $
+# $Id: data.pl,v 1.31 2004/07/10 07:13:43 leo Exp $
=head1 NAME
@@ -45,6 +45,9 @@
cc => $Config{cc},
ccflags => $Config{ccflags},
ccwarn => exists($Config{ccwarn}) ? $Config{ccwarn} : '',
+ # Flags used to indicate this object file is to be compiled
+ # with position-independent code suitable for dynamic loading.
+ cc_shared => $Config{cccdlflags}, # e.g. -fpic for GNU cc.
# C++ compiler -- used to compile parts of ICU. ICU's configure
# will try to find a suitable compiler, but it prefers GNU c++ over
1.5 +15 -1 parrot/languages/m4/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /cvs/public/parrot/languages/m4/ChangeLog,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- ChangeLog 3 Jun 2004 07:35:18 -0000 1.4
+++ ChangeLog 10 Jul 2004 07:13:48 -0000 1.5
@@ -1,4 +1,18 @@
-# $Id: ChangeLog,v 1.4 2004/06/03 07:35:18 leo Exp $
+# $Id: ChangeLog,v 1.5 2004/07/10 07:13:48 leo Exp $
+
+2004-07-06 Bernhard Schmalhofer
+ * Make tests work again
+ * add some tests for 'eval'
+ * yank it up to revision 0.0.7
+
+2004-06-27 Andy Dougherty
+ * Build patches for Solaris, RT#30320
+
+2004-06-21 Bernhard Schmalhofer
+ * Don't write test files into '/tmp'
+
+2004-06-10 Bernhard Schmalhofer
+ * The symbolic link 'blib' isn't needed any more
2004-06-02 Bernhard Schmalhofer
* Start to use t/harness and Parrot::Test
1.3 +3 -1 parrot/languages/m4/doc/features.pod
Index: features.pod
===================================================================
RCS file: /cvs/public/parrot/languages/m4/doc/features.pod,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- features.pod 26 Jan 2004 10:14:19 -0000 1.2
+++ features.pod 10 Jul 2004 07:13:51 -0000 1.3
@@ -1,4 +1,4 @@
-# $Id: features.pod,v 1.2 2004/01/26 10:14:19 leo Exp $
+# $Id: features.pod,v 1.3 2004/07/10 07:13:51 leo Exp $
=head1 TITLE
@@ -8,6 +8,8 @@
=head1 What doesn't works?
+L<../TODO.pod>
+
=head1 What are the differences to GNU m4?
=head1 SEE ALSO
1.3 +11 -3 parrot/languages/m4/doc/running.pod
Index: running.pod
===================================================================
RCS file: /cvs/public/parrot/languages/m4/doc/running.pod,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- running.pod 26 Jan 2004 10:14:19 -0000 1.2
+++ running.pod 10 Jul 2004 07:13:51 -0000 1.3
@@ -1,4 +1,4 @@
-# $Id: running.pod,v 1.2 2004/01/26 10:14:19 leo Exp $
+# $Id: running.pod,v 1.3 2004/07/10 07:13:51 leo Exp $
=head1 TITLE
@@ -7,12 +7,14 @@
=head1 What is Parrot m4?
C<Parrot m4> is C<GNU m4> ported to C<Parrot>. It is implemented in the
-Parrot Intermediate Language (C<PIR>).
+Parrot Intermediate Representation (C<PIR>).
GNU m4, and thus Parrot m4, is a macro processor.
=head2 Installing Parrot m4
-Unpack the archive.
+Get the Parrot distribution. Build parrot.
+ cd languages/m4
+ make
=head1 Running the test suite
@@ -20,12 +22,18 @@
=head1 Running your own code
+ ../../parrot m4.pbc <options> <file.m4>
+
=head2 Command line arguments
+ ../../parrot m4.pbc --help
+
=head2 A simple example
=head1 SEE ALSO
=head1 AUTHOR
+Bernhard.Schmalhofer at gmx.de
+
=cut
1.2 +2 -2 parrot/languages/m4/examples/eval.imc
Index: eval.imc
===================================================================
RCS file: /cvs/public/parrot/languages/m4/examples/eval.imc,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- eval.imc 20 Apr 2004 08:35:55 -0000 1.1
+++ eval.imc 10 Jul 2004 07:13:55 -0000 1.2
@@ -1,10 +1,10 @@
-# $Id: eval.imc,v 1.1 2004/04/20 08:35:55 leo Exp $
+# $Id: eval.imc,v 1.2 2004/07/10 07:13:55 leo Exp $
# See examples/compiler/Makefile for how to generate the needed shared lib
=head1 NAME
-m4_eval.c - Integer arithmetic evaluation for Parrot m4
+eval.imc - Integer arithmetic evaluation for Parrot m4
=head1 DESCRIPTION
1.5 +2 -2 parrot/languages/m4/src/builtin.imc
Index: builtin.imc
===================================================================
RCS file: /cvs/public/parrot/languages/m4/src/builtin.imc,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- builtin.imc 20 Apr 2004 08:35:59 -0000 1.4
+++ builtin.imc 10 Jul 2004 07:13:58 -0000 1.5
@@ -5,7 +5,7 @@
=head2 DESCRIPTION
Copyright: 2004 Bernhard Schmalhofer. All Rights Reserved.
-CVS Info: $Id: builtin.imc,v 1.4 2004/04/20 08:35:59 leo Exp $
+CVS Info: $Id: builtin.imc,v 1.5 2004/07/10 07:13:58 leo Exp $
History: Ported from GNU m4 1.4
References: http://www.gnu.org/software/m4/m4.html
@@ -15,7 +15,7 @@
=cut
# Some named constants
-.include 'iterator.pasm'
+.include '../../runtime/parrot/include/iterator.pasm'
=head1 SUBROUTINES
1.3 +13 -23 parrot/languages/m4/src/eval.c
Index: eval.c
===================================================================
RCS file: /cvs/public/parrot/languages/m4/src/eval.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- eval.c 3 Jun 2004 07:35:25 -0000 1.2
+++ eval.c 10 Jul 2004 07:13:58 -0000 1.3
@@ -1,4 +1,4 @@
-/* $Id: eval.c,v 1.2 2004/06/03 07:35:25 leo Exp $ */
+/* $Id: eval.c,v 1.3 2004/07/10 07:13:58 leo Exp $ */
/* GNU m4 -- A simple macro processor
Copyright (C) 1989, 90, 91, 92, 93, 94 Free Software Foundation, Inc.
@@ -19,6 +19,7 @@
*/
#include <stdlib.h>
+#include <stdio.h>
#include <error.h>
#include <ctype.h>
typedef int boolean;
@@ -26,7 +27,6 @@
typedef int eval_t;
/* Error handling. */
-#define M4ERROR(Arglist) ( error Arglist)
#define CODE_SIZE 128
/* This file contains the functions to evaluate integer expressions for
@@ -282,39 +282,32 @@
break;
case MISSING_RIGHT:
- M4ERROR ((warning_status, 0,
- "Bad expression in eval (missing right parenthesis): %s",
- expr));
+ fprintf( stderr, "Bad expression in eval (missing right parenthesis): %s",
+ expr);
break;
case SYNTAX_ERROR:
- M4ERROR ((warning_status, 0,
- "Bad expression in eval: %s", expr));
+ fprintf( stderr, "Bad expression in eval: %s", expr);
break;
case UNKNOWN_INPUT:
- M4ERROR ((warning_status, 0,
- "Bad expression in eval (bad input): %s", expr));
+ fprintf( stderr, "Bad expression in eval (bad input): %s", expr);
break;
case EXCESS_INPUT:
- M4ERROR ((warning_status, 0,
- "Bad expression in eval (excess input): %s", expr));
+ fprintf( stderr, "Bad expression in eval (excess input): %s", expr);
break;
case DIVIDE_ZERO:
- M4ERROR ((warning_status, 0,
- "Divide by zero in eval: %s", expr));
+ fprintf( stderr, "Divide by zero in eval: %s", expr);
break;
case MODULO_ZERO:
- M4ERROR ((warning_status, 0,
- "Modulo by zero in eval: %s", expr));
+ fprintf( stderr, "Modulo by zero in eval: %s", expr);
break;
default:
- M4ERROR ((warning_status, 0,
- "INTERNAL ERROR: Bad error code in evaluate ()"));
+ fprintf( stderr, "INTERNAL ERROR: Bad error code in evaluate ()");
abort ();
}
@@ -553,8 +546,7 @@
break;
default:
- M4ERROR ((warning_status, 0,
- "INTERNAL ERROR: Bad comparison operator in cmp_term ()"));
+ fprintf( stderr, "INTERNAL ERROR: Bad comparison operator in cmp_term ()");
abort ();
}
}
@@ -596,8 +588,7 @@
break;
default:
- M4ERROR ((warning_status, 0,
- "INTERNAL ERROR: Bad shift operator in shift_term ()"));
+ fprintf( stderr, "INTERNAL ERROR: Bad shift operator in shift_term ()");
abort ();
}
}
@@ -679,8 +670,7 @@
break;
default:
- M4ERROR ((warning_status, 0,
- "INTERNAL ERROR: Bad operator in mult_term ()"));
+ fprintf( stderr, "INTERNAL ERROR: Bad operator in mult_term ()");
abort ();
}
}
1.6 +2 -2 parrot/languages/m4/src/input.imc
Index: input.imc
===================================================================
RCS file: /cvs/public/parrot/languages/m4/src/input.imc,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- input.imc 21 May 2004 19:28:11 -0000 1.5
+++ input.imc 10 Jul 2004 07:13:58 -0000 1.6
@@ -5,7 +5,7 @@
=head1 DESCRIPTION
Copyright: 2004 Bernhard Schmalhofer. All Rights Reserved.
-CVS Info: $Id: input.imc,v 1.5 2004/05/21 19:28:11 jrieks Exp $
+CVS Info: $Id: input.imc,v 1.6 2004/07/10 07:13:58 leo Exp $
History: Ported from GNU m4 1.4
References: http://www.gnu.org/software/m4/m4.html
@@ -215,7 +215,7 @@
.local pmc struct
struct = new SArray
struct = 3
- .include "datatypes.pasm"
+ .include "../../runtime/parrot/include/datatypes.pasm"
struct[0] = .DATATYPE_INT
struct[1] = 2
struct[2] = 0
1.8 +3 -3 parrot/languages/m4/src/m4.imc
Index: m4.imc
===================================================================
RCS file: /cvs/public/parrot/languages/m4/src/m4.imc,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -w -r1.7 -r1.8
--- m4.imc 3 Jun 2004 07:35:25 -0000 1.7
+++ m4.imc 10 Jul 2004 07:13:59 -0000 1.8
@@ -5,7 +5,7 @@
=head1 DESCRIPTION
Copyright: 2004 Bernhard Schmalhofer. All Rights Reserved.
-CVS Info: $Id: m4.imc,v 1.7 2004/06/03 07:35:25 leo Exp $
+CVS Info: $Id: m4.imc,v 1.8 2004/07/10 07:13:59 leo Exp $
Overview: Main of Parrot m4.
History: Ported from GNU m4 1.4
References: http://www.gnu.org/software/m4/m4.html
@@ -87,7 +87,7 @@
# Was '--version' passed ?
is_defined = defined opt["version"]
unless is_defined goto NO_VERSION_FLAG
- print "Parrot m4 0.0.6\n"
+ print "Parrot m4 0.0.7\n"
end
NO_VERSION_FLAG:
@@ -309,7 +309,7 @@
.sub _usage
.param string program_name
- print "Usage: ./parrot "
+ print "Usage: ../../parrot "
print program_name
print " [OPTION]... FILE\n"
print "\n"
1.6 +4 -4 parrot/languages/m4/t/basic/003_getopt.t
Index: 003_getopt.t
===================================================================
RCS file: /cvs/public/parrot/languages/m4/t/basic/003_getopt.t,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- 003_getopt.t 3 Jun 2004 07:35:28 -0000 1.5
+++ 003_getopt.t 10 Jul 2004 07:14:02 -0000 1.6
@@ -1,4 +1,4 @@
-# $Id: 003_getopt.t,v 1.5 2004/06/03 07:35:28 leo Exp $
+# $Id: 003_getopt.t,v 1.6 2004/07/10 07:14:02 leo Exp $
# pragmata
use strict;
@@ -6,14 +6,14 @@
use Test::More tests => 25;
my $real_out;
-my $parrot_m4 = 'cd ..; ./parrot languages/m4/m4.pbc';
+my $parrot_m4 = 'cd .. && ./parrot languages/m4/m4.pbc';
my $examples_dir = 'languages/m4/examples';
#--------------------------------------------
$real_out = `$parrot_m4 --help 2>&1`;
is( $real_out, << "END_OUT", '--help' );
-Usage: ./parrot languages/m4/m4.pbc [OPTION]... FILE
+Usage: ../../parrot languages/m4/m4.pbc [OPTION]... FILE
Currently only long options are available.
@@ -31,7 +31,7 @@
#--------------------------------------------
$real_out = `$parrot_m4 --version 2>&1`;
is( $real_out, << 'END_OUT', '--version' );
-Parrot m4 0.0.6
+Parrot m4 0.0.7
END_OUT
1.3 +1 -2 parrot/languages/m4/t/basic/012_eval.t
Index: 012_eval.t
===================================================================
RCS file: /cvs/public/parrot/languages/m4/t/basic/012_eval.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- 012_eval.t 3 Jun 2004 07:35:28 -0000 1.2
+++ 012_eval.t 10 Jul 2004 07:14:02 -0000 1.3
@@ -1,4 +1,4 @@
-# $Id: 012_eval.t,v 1.2 2004/06/03 07:35:28 leo Exp $
+# $Id: 012_eval.t,v 1.3 2004/07/10 07:14:02 leo Exp $
use strict;
@@ -6,7 +6,6 @@
my $real_out;
my $parrot = 'cd .. && ./parrot';
-my $parrot_m4 = "$parrot languages/m4/m4.pbc";
$real_out = `$parrot languages/m4/examples/eval.imc 2>&1`;
is( $real_out, << 'END_OUT', 'single file' );
1.3 +70 -3 parrot/languages/m4/t/builtins/011_eval.t
Index: 011_eval.t
===================================================================
RCS file: /cvs/public/parrot/languages/m4/t/builtins/011_eval.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- 011_eval.t 3 Jun 2004 07:35:04 -0000 1.2
+++ 011_eval.t 10 Jul 2004 07:14:05 -0000 1.3
@@ -1,17 +1,29 @@
-# $Id: 011_eval.t,v 1.2 2004/06/03 07:35:04 leo Exp $
+# $Id: 011_eval.t,v 1.3 2004/07/10 07:14:05 leo Exp $
use strict;
-use Parrot::Test tests => 1;
+use Parrot::Test tests => 2;
+
+# Test the m4-Builtin function 'eval'
{
- language_output_is( 'm4', <<'CODE', <<'OUT', 'substring in middle of string' );
+ language_output_is( 'm4', <<'CODE', <<'OUT', 'basic expressions' );
eval( `4')
eval( `0')
eval( `-4')
eval( `-0')
eval( ` 1 + 1 ' )
eval( ` 42 + -43 ' )
+eval( `42 + -44' )
+eval(`4*4')
+eval(`4*4')
+eval( `5 * 6' )
+eval( `-20 / 4' )
+eval( `-20 / 4 * 8' )
+eval( `-20 / 4 * 8 + 17' )
+asdf eval( `-20 / 4 * 8 + 17' ) jklm
+-23 = eval( `-20 / 4 * 8 + 17' ) jklm
+-20 / 4 * 8 + 17 = eval( `-20 / 4 * 8 + 17' ) jklm
CODE
4
0
@@ -19,6 +31,61 @@
0
2
-1
+-2
+16
+16
+30
+-5
+-40
+-23
+asdf -23 jklm
+-23 = -23 jklm
+-20 / 4 * 8 + 17 = -23 jklm
+OUT
+}
+
+
+{
+ language_output_is( 'm4', <<'CODE', <<'OUT', 'all ops besides bitwise ops' );
+1 eval( `4**5')
+2 eval( `2**10')
+3 eval( ` 2 ** 10 ' )
+4 eval( ` -2 ** 10 ' )
+5 eval( ` -4 *512 / -2 ' )
+6 eval( ` 2049 % 1025 ' )
+7 eval( ` 2048 >> 1 ' )
+8 eval( ` 256 <<2 ' )
+9 eval( ` 256 == 1024 / 4' )
+10 eval( ` 256 != 1024 / 4' )
+11 eval( ` 256 <= 256' )
+12 eval( ` 256 >= 256' )
+13 eval( ` 256 > 256' )
+14 eval( ` 256 > 256' )
+15 eval( ` 256 > 257' )
+16 eval( ` ! 256 > 257' )
+17 eval( ` !! ! 256 > 257' )
+18 eval( ` 1 && 0' )
+19 eval( ` 1026 || 0' )
+CODE
+1 1024
+2 1024
+3 1024
+4 1024
+5 1024
+6 1024
+7 1024
+8 1024
+9 1
+10 0
+11 1
+12 1
+13 0
+14 0
+15 0
+16 1
+17 1
+18 0
+19 1
OUT
}
1.2 +14 -8 parrot/languages/m4/t/harness
Index: harness
===================================================================
RCS file: /cvs/public/parrot/languages/m4/t/harness,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- harness 3 Jun 2004 07:35:08 -0000 1.1
+++ harness 10 Jul 2004 07:14:07 -0000 1.2
@@ -1,4 +1,4 @@
-# $Id: harness,v 1.1 2004/06/03 07:35:08 leo Exp $
+# $Id: harness,v 1.2 2004/07/10 07:14:07 leo Exp $
# pragmata
use strict;
@@ -14,7 +14,14 @@
=head1 SYNOPSIS
- cd languages && perl m4/t/harness -files
+ cd languages && perl -I../lib m4/t/harness -files
+
+ cd languages && perl -I../lib m4/t/harness
+
+ cd languages && perl -I../lib m4/t/harness \
+ m4/t/basic/006_define_with_rest \
+ m4/t/regex/003_two_compiles.t
+
=head1 DESCRIPTION
@@ -24,13 +31,13 @@
If I'm called with no args, I run all tests.
-Otherwise I try to run list of passed tests.
+Otherwise I try to run the list of passed tests.
=cut
-if ( grep { /^-files$/ } @ARGV )
+if ( grep { m/^-files$/ } @ARGV )
{
- # I must be running out of languages/
+ # Only the Makefile in 'parrot/languages' uses -file
my $dir = File::Spec->catfile( $language, 't' );
my @files = glob( File::Spec->catfile( $dir, '*/*.t' ) );
print join( "\n", @files );
@@ -46,8 +53,7 @@
}
else
{
- # I must be running out of languages/$language
- # You may want a deeper search than this.
+ # Propably called out of 'parrot/languages'
@files = glob( "m4/t/*/*.t" );
}
runtests( @files ) if scalar(@files);
@@ -59,7 +65,7 @@
=head1 SEE ALSO
- L<languages/tcl/t/harness>
+ L<languages/tcl/t/harness>, L<languages/python/t/harness>
=head1 AUTHOR
1.4 +10 -20 parrot/languages/m4/t/regex/003_two_compiles.t
Index: 003_two_compiles.t
===================================================================
RCS file: /cvs/public/parrot/languages/m4/t/regex/003_two_compiles.t,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- 003_two_compiles.t 3 Jun 2004 07:35:34 -0000 1.3
+++ 003_two_compiles.t 10 Jul 2004 07:14:10 -0000 1.4
@@ -1,4 +1,4 @@
-# $Id: 003_two_compiles.t,v 1.3 2004/06/03 07:35:34 leo Exp $
+# $Id: 003_two_compiles.t,v 1.4 2004/07/10 07:14:10 leo Exp $
use strict;
@@ -220,15 +220,7 @@
# compile regular expression 'df'
.local pmc re_df
- .pcc_begin prototyped
- .arg 'df'
- .arg 0
- .arg error
- .arg errptr
- .arg NULL
- .nci_call pcre_compile
- .result re_df
- .pcc_end
+ .PCRE_COMPILE('df', 0, re_df, error, errptr)
# Variables for matching
.local string s
@@ -254,8 +246,9 @@
.result ok
.pcc_end
if ok < 0 goto EXEC_FAILED
+ print "ok: "
print ok
- print " match(es):\n"
+ print " 'as' matches\n"
# Try another match
.pcc_begin prototyped
@@ -270,9 +263,10 @@
.nci_call pcre_exec
.result ok
.pcc_end
+ print "ok: "
print ok
if ok < 0 goto NO_MATCH
- print " match(es):\n"
+ print " 'df' matches\n"
end
@@ -290,8 +284,8 @@
END_PIR
pir_output_is( $pir, << 'OUTPUT', "calling pcre_compile directly two times" );
-1 match(es):
-1 match(es):
+ok: 1 'as' matches
+ok: 1 'df' matches
OUTPUT
}
if ( 0 )
@@ -437,12 +431,8 @@
END_PIR
pir_output_is( $pir, << 'OUTPUT', "calling .PCRE_COMPILE two times" );
-
-1 match(es):
-as
-
-1 match(es):
-df
+ok: 1 'as' match(es):
+ok: 1 'df' match(es):
OUTPUT
}
1.3 +31 -30 parrot/lib/Parrot/Test/m4.pm
Index: m4.pm
===================================================================
RCS file: /cvs/public/parrot/lib/Parrot/Test/m4.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- m4.pm 3 Jun 2004 07:35:40 -0000 1.2
+++ m4.pm 10 Jul 2004 07:14:13 -0000 1.3
@@ -1,19 +1,25 @@
-# $Id: m4.pm,v 1.2 2004/06/03 07:35:40 leo Exp $
+# $Id: m4.pm,v 1.3 2004/07/10 07:14:13 leo Exp $
use strict;
+use Data::Dumper;
use File::Basename;
package Parrot::Test::m4;
-use Data::Dumper;
+=head1 NAME
+
+Test/m4.pm - Testing routines specific to 'm4'.
+
+=head1 DESCRIPTION
+
+Call 'Parrot m4' and 'GNU m4'.
-=head1
+=head1 METHODS
-Provide language specific testing routines here...
+=head2 new
-This is currently alarmingly similar to the generated subs in Parrot::Test.
-Perhaps someone can do a better job of delegation here.
+Yet another constructor.
=cut
@@ -22,48 +28,43 @@
return bless {};
}
-sub output_is()
+
+=head2 output_is
+
+This gets called when language_output_is() is called in a test file.
+
+=cut
+
+sub output_is
{
- my ( $self, $code, $output, $desc ) = @_;
+ my $self = shift;
+ my ( $code, $output, $desc ) = @_;
my $count = $self->{builder}->current_test + 1;
# flatten filenames (don't use directories)
- # but, always put the test in a tempdir, so we're not cluttering
my $lang_f = Parrot::Test::per_test( '.m4', $count );
- $lang_f = ( File::Spec->splitpath( $lang_f ) )[2];
- $lang_f = File::Spec->catfile( File::Spec->tmpdir(), $lang_f );
-
my $parrot_m4_out_f = Parrot::Test::per_test( '.parrot_out', $count );
- $parrot_m4_out_f = ( File::Spec->splitpath( $parrot_m4_out_f ) )[2];
- $parrot_m4_out_f = File::Spec->catfile( File::Spec->tmpdir(), $parrot_m4_out_f
);
-
my $gnu_m4_out_f = Parrot::Test::per_test( '.gnu_out', $count );
- $gnu_m4_out_f = ( File::Spec->splitpath( $gnu_m4_out_f ) )[2];
- $gnu_m4_out_f = File::Spec->catfile( File::Spec->tmpdir(), $gnu_m4_out_f );
+ my $test_prog_args = $ENV{TEST_PROG_ARGS} || '';
+ my $parrot_m4 = "(cd $self->{relpath} && $self->{parrot} languages/m4/m4.pbc
${test_prog_args} languages/${lang_f})";
+ my $gnu_m4 = "(cd $self->{relpath} && m4 ${test_prog_args}
languages/${lang_f})";
+
+ # This does nor create byte code, but m4 code
my $parrotdir = File::Basename::dirname( $self->{parrot} );
Parrot::Test::generate_pbc_for( $code, $parrotdir, $count, $lang_f );
- my $test_prog_args = $ENV{TEST_PROG_ARGS} || '';
- my $parrot_m4 = "(cd $self->{relpath} && $self->{parrot}
languages/m4/m4.pbc ${test_prog_args} ${lang_f})";
- my $gnu_m4 = "(cd $self->{relpath} && m4 ${test_prog_args} ${lang_f})";
-
- # For some reason, if you redirect both STDERR and STDOUT here,
- # you get a 38M file of garbage. We'll temporarily assume everything
- # works and ignore stderr.
+ # TODO: Don't ignore STDERR
my $exit_code = Parrot::Test::_run_command( $parrot_m4, STDOUT =>
$parrot_m4_out_f );
$exit_code = Parrot::Test::_run_command( $gnu_m4, STDOUT => $gnu_m4_out_f );
my $pass = $self->{builder}->is_eq( Parrot::Test::slurp_file($parrot_m4_out_f) .
Parrot::Test::slurp_file($parrot_m4_out_f), , $output . $output, $desc );
$self->{builder}->diag( "'$parrot_m4' failed with exit code $exit_code" ) if
$exit_code and not $pass;
+ # die Data::Dumper::Dumper( $lang_f, `pwd`, $parrot_m4, $parrotdir,
$parrot_m4_out_f );
- unless ( $ENV{POSTMORTEM} )
- {
- unlink( $lang_f );
- unlink( $parrot_m4_out_f );
- unlink( $gnu_m4_out_f );
- }
+ # The generated files are left in the t/* directories.
+ # Let 'make clean' and '.cvsignore' take care of them.
return $pass;
}
1.2 +30 -19 parrot/runtime/parrot/library/Getopt/Long.imc
Index: Long.imc
===================================================================
RCS file: /cvs/public/parrot/runtime/parrot/library/Getopt/Long.imc,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- Long.imc 26 May 2004 08:51:14 -0000 1.1
+++ Long.imc 10 Jul 2004 07:14:15 -0000 1.2
@@ -1,4 +1,4 @@
-# $Id: Long.imc,v 1.1 2004/05/26 08:51:14 jrieks Exp $
+# $Id: Long.imc,v 1.2 2004/07/10 07:14:15 leo Exp $
=head1 NAME
@@ -11,15 +11,16 @@
=head1 DESCRIPTION
This PIR library can be used for parsing command line options.
-A single subroutine, get_options(), is provided.
+A single subroutine, _get_options(), is provided.
=head1 SUBROUTINES
=head2 _get_options
This should work like the Perl5 module Getopt::Long.
-Takes a format specifier and an argument vector.
-Returns a PerlHash.
+Takes an array of options and an array of specifications.
+
+A PerlHash is returned.
=cut
@@ -28,18 +29,18 @@
.param PerlArray spec
# Loop over the array spec and build up two simple hashes
- .local PerlHash type # the type of the option: binary, string,
integer
+ .local pmc type # the type of the option: binary, string, integer
type = new PerlHash
- .local int cnt_spec # a counter for looping over the array 'spec'
- cnt_spec = 0
- .local int len_spec # for end condition of loop over 'spec'
- len_spec = spec
+ .local int curr_spec # a counter for looping over the array 'spec'
+ curr_spec = 0
+ .local int max_spec # for end condition of loop over 'spec'
+ max_spec = spec
.local int spec_index # searching for patterns in 'spec'
.local string opt_name # name of specified option
.local string opt_type # tyep of specified option
goto CHECK_PARSE_SPEC
NEXT_PARSE_SPEC: # Look at next element in 'spec'
- opt_name = spec[cnt_spec]
+ opt_name = spec[curr_spec]
spec_index = index opt_name, '=' # when '=' is not in 'opt_name' then it's
binary
if spec_index != -1 goto NOT_A_BINARY_OPTION
opt_type = 'b'
@@ -48,12 +49,13 @@
inc spec_index # we know where '=', thus the type is one
further
opt_type = substr opt_name, spec_index, 1
dec spec_index # Go back to the '='
+ # TODO: what if we have something like name=xy ?
opt_name = substr spec_index, 2, '' # The stuff before '=' is the option name
OPTION_TYPE_IS_NOW_KNOWN:
type[opt_name] = opt_type
- inc cnt_spec
+ inc curr_spec
CHECK_PARSE_SPEC: # check wether loop over 'spec' is complete
- if cnt_spec < len_spec goto NEXT_PARSE_SPEC
+ if curr_spec < max_spec goto NEXT_PARSE_SPEC
# uncomment this if you want debug output
goto SKIP_DEBUG_OUTPUT
@@ -64,7 +66,7 @@
# we actually parse the argument vector
# TODO: do this correctly
# shift from argv until a non-option is encountered
- .local PerlHash opt # the return PMC
+ .local pmc opt # the return PMC
opt = new PerlHash
.local string arg # element of argument array
.local string value # element of argument array
@@ -75,12 +77,20 @@
NEXT_PARSE_ARGV:
# first we take a peek at the first remaining element
arg = argv[0]
- # Is arg a option string like '--help'
+
+ # Is arg a long option string like '--help'
+ # TODO: how about asdf--jkl ???
arg_index = index arg, '--'
- if arg_index > -1 goto HANDLE_OPTION
+ if arg_index > -1 goto HANDLE_LONG_OPTION
+
+ # Is arg a short option string like '-v'
+ arg_index = index arg, '-'
+ if arg_index > -1 goto HANDLE_SHORT_OPTION
# We are done, and don't want to loose the nonoption argument
goto FINISH_PARSE_ARGV
- HANDLE_OPTION:
+
+ HANDLE_SHORT_OPTION:
+ HANDLE_LONG_OPTION:
# we take the current option off argv
arg = shift argv
# get rid of the leading '--'
@@ -117,6 +127,7 @@
CHECK_PARSE_ARGV:
num_remaining_args = argv
if num_remaining_args > 0 goto NEXT_PARSE_ARGV
+
FINISH_PARSE_ARGV:
# Nothing to do here
