cvsuser 03/12/04 02:30:39
Modified: imcc imcc.l
imcc/t/syn macro.t pcc.t
include/parrot warnings.h
src exceptions.c warnings.c
t/op globals.t interp.t
t/pmc exception.t perlarray.t pmc.t scratchpad.t sub.t
Log:
* #24584: corretly report error location in macros
courtesy of Bernhard Schmalhofer
* print error location of exceptions
The file/line info is available, when run with the -w switch or
when warningson is encountered in the source and only for slow cores.
Line numbers for PIR files are inexact, e.g. when imcc expands
sub calls.
Revision Changes Path
1.81 +2 -1 parrot/imcc/imcc.l
Index: imcc.l
===================================================================
RCS file: /cvs/public/parrot/imcc/imcc.l,v
retrieving revision 1.80
retrieving revision 1.81
diff -u -w -r1.80 -r1.81
--- imcc.l 3 Dec 2003 14:03:14 -0000 1.80
+++ imcc.l 4 Dec 2003 10:30:10 -0000 1.81
@@ -682,6 +682,8 @@
UNUSED(valp);
frame = new_frame();
+ /* When an error occurs, then report it as being in a macro */
+ frame->is_macro = 1;
expansion = find_macro_param(name);
if (expansion) {
@@ -695,7 +697,6 @@
/* remember macro name for error reporting
*/
sourcefile = const_cast(name);
- frame->is_macro = 1;
/* whitespace can be savely ignored */
do {
c = input();
1.5 +25 -1 parrot/imcc/t/syn/macro.t
Index: macro.t
===================================================================
RCS file: /cvs/public/parrot/imcc/t/syn/macro.t,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- macro.t 23 Oct 2003 17:03:01 -0000 1.4
+++ macro.t 4 Dec 2003 10:30:16 -0000 1.5
@@ -1,6 +1,6 @@
#!perl
use strict;
-use TestCompiler tests => 21;
+use TestCompiler tests => 23;
# macro tests
@@ -281,5 +281,29 @@
.end
CODE
/unknown macro/
+OUTPUT
+
+output_like( <<'CODE', <<OUTPUT, "unexpected IDENTIFIER" );
+.sub _main
+.macro M()
+ this gives a parse error
+.endm
+ .M()
+ end
+.end
+CODE
+/parse error, unexpected IDENTIFIER/
+OUTPUT
+
+output_like( <<'CODE', <<OUTPUT, "unknown macro" );
+.sub _main
+.macro M(A)
+ .arg .A
+.endm
+ .M(a)
+ end
+.end
+CODE
+/in macro '.M'/
OUTPUT
1.26 +11 -10 parrot/imcc/t/syn/pcc.t
Index: pcc.t
===================================================================
RCS file: /cvs/public/parrot/imcc/t/syn/pcc.t,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -w -r1.25 -r1.26
--- pcc.t 19 Nov 2003 07:33:43 -0000 1.25
+++ pcc.t 4 Dec 2003 10:30:16 -0000 1.26
@@ -251,7 +251,7 @@
back
OUT
-output_is(<<'CODE', <<'OUT', "wrong param count exception S arg");
+output_like(<<'CODE', <<'OUT', "wrong param count exception S arg");
.sub _main
.local Sub sub
newsub sub, .Sub, _sub
@@ -273,10 +273,10 @@
.pcc_end_return
.end
CODE
-wrong param count
+/wrong param count/
OUT
-output_is(<<'CODE', <<'OUT', "wrong param count exception P arg");
+output_like(<<'CODE', <<'OUT', "wrong param count exception P arg");
.sub _main
.local Sub sub
newsub sub, .Sub, _sub
@@ -298,10 +298,10 @@
.pcc_end_return
.end
CODE
-wrong param count
+/wrong param count/
OUT
-output_is(<<'CODE', <<'OUT', "wrong param count exception, call 2 subs");
+output_like(<<'CODE', <<'OUT', "wrong param count exception, call 2 subs");
.sub _main
.local Sub sub
newsub sub, .Sub, _sub
@@ -341,9 +341,10 @@
.pcc_end_return
.end
CODE
-ok 1
+/ok 1
ok 2
wrong param count
+/
OUT
@@ -384,7 +385,7 @@
ok
OUT
-output_is(<<'CODE', <<'OUT', "wrong param type exception");
+output_like(<<'CODE', <<'OUT', "wrong param type exception");
.sub _main
.local Sub sub
newsub sub, .Sub, _sub
@@ -405,10 +406,10 @@
.pcc_end_return
.end
CODE
-wrong param type
+/wrong param type/
OUT
-output_is(<<'CODE', <<'OUT', "wrong param type exception - 2 params");
+output_like(<<'CODE', <<'OUT', "wrong param type exception - 2 params");
.sub _main
.local Sub sub
$S0 = "ok 1\n"
@@ -432,7 +433,7 @@
.pcc_end_return
.end
CODE
-wrong param type
+/wrong param type/
OUT
####################
1.13 +4 -4 parrot/include/parrot/warnings.h
Index: warnings.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/warnings.h,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -w -r1.12 -r1.13
--- warnings.h 3 Jul 2003 10:03:57 -0000 1.12
+++ warnings.h 4 Dec 2003 10:30:23 -0000 1.13
@@ -31,11 +31,11 @@
#include "parrot/parrot.h"
-INTVAL Parrot_warn(struct Parrot_Interp *, INTVAL warnclass,
- const char *message, ...);
+void print_pbc_location(Parrot_Interp);
-INTVAL Parrot_warn_s(struct Parrot_Interp *, INTVAL warnclass,
- STRING *message, ...);
+INTVAL Parrot_warn(Parrot_Interp, INTVAL warnclass, const char *message, ...);
+
+INTVAL Parrot_warn_s(Parrot_Interp, INTVAL warnclass, STRING *message, ...);
#endif
1.43 +2 -1 parrot/src/exceptions.c
Index: exceptions.c
===================================================================
RCS file: /cvs/public/parrot/src/exceptions.c,v
retrieving revision 1.42
retrieving revision 1.43
diff -u -w -r1.42 -r1.43
--- exceptions.c 22 Nov 2003 09:55:49 -0000 1.42
+++ exceptions.c 4 Dec 2003 10:30:28 -0000 1.43
@@ -1,7 +1,7 @@
/* exceptions.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: exceptions.c,v 1.42 2003/11/22 09:55:49 leo Exp $
+ * $Id: exceptions.c,v 1.43 2003/12/04 10:30:28 leo Exp $
* Overview:
* define the internal interpreter exceptions
* Data Structure and Algorithms:
@@ -139,6 +139,7 @@
else
fprintf(stderr, "No exception handler and no message\n");
}
+ print_pbc_location(interpreter);
Parrot_exit(exit_status);
return NULL;
1.18 +22 -10 parrot/src/warnings.c
Index: warnings.c
===================================================================
RCS file: /cvs/public/parrot/src/warnings.c,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -w -r1.17 -r1.18
--- warnings.c 23 Oct 2003 17:48:59 -0000 1.17
+++ warnings.c 4 Dec 2003 10:30:28 -0000 1.18
@@ -24,27 +24,39 @@
return -1;
}
-static INTVAL
-print_warning(struct Parrot_Interp *interpreter, STRING *msg)
+/*
+ * print warning/error location in PBC to stderr
+ * use fprintf only - may called from exceptions
+ */
+void
+print_pbc_location(Parrot_Interp interpreter)
{
const char *file;
int line;
struct PackFile_Debug * debugs = interpreter->code->cur_cs->debugs;
-
- if (!msg)
- return -1;
if (debugs) {
file = debugs->filename;
line = find_line(interpreter, debugs);
}
else {
file = "(unknown file)";
- line = 0;
+ line = -1;
+ }
+ fprintf(stderr, "\tin file '%s' near line %d\n", file, line);
}
- if (PIO_eprintf(interpreter, "%S at %s line %d.\n", msg, file, line))
- return -2;
- else
+static INTVAL
+print_warning(struct Parrot_Interp *interpreter, STRING *msg)
+{
+
+ if (!msg)
+ fprintf(stderr, "Unknown warning\n");
+ else {
+ PIO_putps(interpreter, PIO_STDERR(interpreter), msg);
+ if (string_ord(msg, -1) != '\n')
+ fprintf(stderr, "%c", '\n');
+ }
+ print_pbc_location(interpreter);
return 1;
}
1.5 +2 -2 parrot/t/op/globals.t
Index: globals.t
===================================================================
RCS file: /cvs/public/parrot/t/op/globals.t,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- globals.t 17 Aug 2003 19:27:04 -0000 1.4
+++ globals.t 4 Dec 2003 10:30:33 -0000 1.5
@@ -13,12 +13,12 @@
end
CODE
-output_is(<<'CODE', <<OUT, "not found exception");
+output_like(<<'CODE', <<OUT, "not found exception");
find_global P1, "no_such_global"
print "ok 1\n"
print P1
end
CODE
-Global 'no_such_global' not found
+/Global 'no_such_global' not found/
OUT
1; # HONK
1.14 +1 -1 parrot/t/op/interp.t
Index: interp.t
===================================================================
RCS file: /cvs/public/parrot/t/op/interp.t,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -w -r1.13 -r1.14
--- interp.t 30 Aug 2003 10:01:25 -0000 1.13
+++ interp.t 4 Dec 2003 10:30:33 -0000 1.14
@@ -45,7 +45,7 @@
set I0, P1
end
CODE
-/^nada:Use of uninitialized value in integer context at.*/
+/^nada:Use of uninitialized value in integer context/
OUTPUT
output_is(<<'CODE', <<'OUTPUT', "getinterp");
1.5 +15 -11 parrot/t/pmc/exception.t
Index: exception.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/exception.t,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- exception.t 29 Aug 2003 11:30:20 -0000 1.4
+++ exception.t 4 Dec 2003 10:30:38 -0000 1.5
@@ -171,17 +171,17 @@
43
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "throw - no handler");
+output_like(<<'CODE', <<'OUTPUT', "throw - no handler");
new P0, .Exception
set P0["_message"], "something happend"
throw P0
print "not reached\n"
end
CODE
-something happend
+/something happend/
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "throw - no handler, no message");
+output_like(<<'CODE', <<'OUTPUT', "throw - no handler, no message");
newsub P20, .Exception_Handler, _handler
set_eh P20
new P0, .Exception
@@ -192,17 +192,18 @@
_handler:
end
CODE
-No exception handler and no message
+/No exception handler and no message/
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "throw - no handler, no message");
+output_like(<<'CODE', <<'OUTPUT', "throw - no handler, no message");
new P0, .Exception
throw P0
print "not reached\n"
end
CODE
-No exception handler and no message
+/No exception handler and no message/
OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', "2 exception handlers");
print "main\n"
newsub P20, .Exception_Handler, _handler1
@@ -370,7 +371,7 @@
severity 3
OUT
-output_is(<<'CODE', <<OUT, "die_hard - no handler");
+output_like(<<'CODE', <<OUT, "die_hard - no handler");
die_hard 3, 100
print "not reached\n"
end
@@ -378,7 +379,7 @@
print "catched it\n"
end
CODE
-No exception handler and no message
+/No exception handler and no message/
OUT
output_like(<<'CODE', <<OUT, "find_lex");
@@ -472,7 +473,7 @@
mark2
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "check that coroutines handler isnt run");
+output_like(<<'CODE', <<'OUTPUT', "check that coroutines handler isnt run");
print "main\n"
newsub P0, .Coroutine, _sub
invokecc
@@ -494,17 +495,20 @@
set P2, P5["_invoke_cc"] # the return continuation
invoke P2
CODE
-main
+/main
in coro
back in main
Lexical 'nix' not found
+/
OUTPUT
-output_is(<<'CODE', '', "exit exception");
+output_like(<<'CODE', <<'OUTPUT', "exit exception");
noop
exit 0
print "not reached\n"
end
CODE
+/in file/
+OUTPUT
1;
1.32 +8 -4 parrot/t/pmc/perlarray.t
Index: perlarray.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/perlarray.t,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -w -r1.31 -r1.32
--- perlarray.t 22 Aug 2003 11:35:45 -0000 1.31
+++ perlarray.t 4 Dec 2003 10:30:38 -0000 1.32
@@ -1361,13 +1361,17 @@
OK4: print "ok 4\\n"
end
CODE
-/Use of uninitialized value at .*
+/Use of uninitialized value
+\s+in file.*
ok 1
-Use of uninitialized value at .*
+Use of uninitialized value
+\s+in file.*
ok 2
-Use of uninitialized value at .*
+Use of uninitialized value
+\s+in file.*
ok 3
-Use of uninitialized value at .*
+Use of uninitialized value
+\s+in file.*
ok 4
/
OUTPUT
1.73 +7 -6 parrot/t/pmc/pmc.t
Index: pmc.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/pmc.t,v
retrieving revision 1.72
retrieving revision 1.73
diff -u -w -r1.72 -r1.73
--- pmc.t 28 Oct 2003 03:45:36 -0000 1.72
+++ pmc.t 4 Dec 2003 10:30:38 -0000 1.73
@@ -2268,22 +2268,23 @@
ok 4
OUTPUT
-output_like(<<"CODE", <<OUTPUT, "undef warning");
+output_like(<<"CODE", <<'OUTPUT', "undef warning");
.include "warnings.pasm"
warningson .PARROT_WARNINGS_UNDEF_FLAG
new P0, .PerlUndef
print P0
end
CODE
-/Use of uninitialized.*pasm/i
+/Use of uninitialized.*
+\s+in file .*pasm/i
OUTPUT
-output_is(<<"CODE", <<OUTPUT, "find_method");
+output_like(<<"CODE", <<'OUTPUT', "find_method");
new P1, .PerlInt
find_method P0, P1, "no_such_meth"
end
CODE
-Method 'no_such_meth' not found
+/Method 'no_such_meth' not found/
OUTPUT
output_like(<<'CODE', <<'OUTPUT', "new with a native type");
1.4 +4 -3 parrot/t/pmc/scratchpad.t
Index: scratchpad.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/scratchpad.t,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- scratchpad.t 16 Aug 2003 16:45:19 -0000 1.3
+++ scratchpad.t 4 Dec 2003 10:30:38 -0000 1.4
@@ -179,7 +179,7 @@
new P20, .PerlInt
- set P22, P21[0;"var0"] # original pad should be gc'ed
+ set P22, P21[0;"var0"] # original pad should be gced
set P23, P21[0;"var1"]
print P22
@@ -192,7 +192,7 @@
101
OUTPUT
-output_is(<<'CODE', <<OUTPUT, "delete");
+output_like(<<'CODE', <<'OUTPUT', "delete");
new_pad 0
new P1, .PerlString
set P1, "ok 1\n"
@@ -205,8 +205,9 @@
print P2
end
CODE
-ok 1
+/ok 1
Lexical 'foo' not found
+/
OUTPUT
1;
1.31 +6 -3 parrot/t/pmc/sub.t
Index: sub.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/sub.t,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -w -r1.30 -r1.31
--- sub.t 1 Nov 2003 16:33:28 -0000 1.30
+++ sub.t 4 Dec 2003 10:30:38 -0000 1.31
@@ -380,7 +380,8 @@
set I0, P0
invoke P1
CODE
-/^main:Use of uninitialized value in integer context at.*:back$/sm
+/^main:Use of uninitialized value in integer context
+\s+in file.*:back$/s
OUTPUT
output_like(<<'CODE', <<'OUTPUT', "interp - warnings 2");
@@ -402,7 +403,8 @@
set I0, P0
invoke P1
CODE
-/^Use of uninitialized value in integer context at.*:main:back:Use of un.*$/sm
+/^Use of uninitialized value in integer context
+\s+in file.*:main:back:Use of un.*$/sm
OUTPUT
output_like(<<'CODE', <<'OUTPUT', "interp - warnings 2 - updatecc");
@@ -429,7 +431,8 @@
set I0, P0
invoke P1
CODE
-/^Use of uninitialized value in integer context at.*:main:back:Use of un.*$/sm
+/^Use of uninitialized value in integer context
+\s+in file.*:main:back:Use of un.*$/sm
OUTPUT
output_is(<<'CODE', <<'OUTPUT', "pcc sub");
