[m-rev.] for review: fix construct__get_functor/6
Simon Taylor
stayl at cs.mu.OZ.AU
Thu Nov 21 19:32:35 AEDT 2002
Estimated hours taken: 0.5
Branches: main, release
runtime/mercury_type_info.c:
Fix a segfault in MR_arg_name_vector_to_list() (called by
construct__get_functor/6) when none of the fields of the
constructor being examined have names.
library/construct.m:
construct__get_functor/6 was returning an empty list of field
names for tuples. The correct result is a list of `no's.
tests/hard_coded/construct.{m,exp}:
Test construct__get_functor/6.
Index: runtime/mercury_type_info.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.c,v
retrieving revision 1.53
diff -u -u -r1.53 mercury_type_info.c
--- runtime/mercury_type_info.c 1 Aug 2002 11:52:28 -0000 1.53
+++ runtime/mercury_type_info.c 21 Nov 2002 08:12:46 -0000
@@ -432,10 +432,20 @@
MR_restore_transient_registers();
arg_names_list = MR_list_empty();
- while (arity > 0) {
- --arity;
- arg_names_list = MR_list_cons((MR_Word) arg_names[arity],
- arg_names_list);
+ if (arg_names == NULL) {
+ /* No arguments have names. */
+ while (arity > 0) {
+ --arity;
+ arg_names_list =
+ MR_list_cons((MR_Word) NULL, arg_names_list);
+ }
+ } else {
+ while (arity > 0) {
+ --arity;
+ arg_names_list =
+ MR_list_cons((MR_Word) arg_names[arity],
+ arg_names_list);
+ }
}
MR_save_transient_registers();
Index: library/construct.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/construct.m,v
retrieving revision 1.7
diff -u -u -r1.7 construct.m
--- library/construct.m 1 Aug 2002 11:52:23 -0000 1.7
+++ library/construct.m 21 Nov 2002 07:57:49 -0000
@@ -235,11 +235,16 @@
if (MR_TYPE_CTOR_INFO_IS_TUPLE(
MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info)))
{
+ int i;
MR_save_transient_registers();
TypeInfoList = MR_type_params_vector_to_list(Arity,
MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info));
ArgNameList = MR_list_empty();
- MR_restore_transient_registers();
+ for (i = 0; i < Arity; i++) {
+ ArgNameList = MR_list_cons_msg(NULL,
+ ArgNameList, MR_PROC_LABEL);
+ }
+ MR_restore_transient_registers();
} else {
MR_save_transient_registers();
TypeInfoList = MR_pseudo_type_info_vector_to_type_info_list(
Index: tests/hard_coded/construct_test.exp
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/construct_test.exp,v
retrieving revision 1.1
diff -u -u -r1.1 construct_test.exp
--- tests/hard_coded/construct_test.exp 30 Jan 2002 05:09:09 -0000 1.1
+++ tests/hard_coded/construct_test.exp 21 Nov 2002 08:21:06 -0000
@@ -1,123 +1,123 @@
TESTING DISCRIMINATED UNIONS
3 functors in this type
-2 - two/0
-1 - three/0
-0 - one/0
+2 - two/0 []
+1 - three/0 []
+0 - one/0 []
3 functors in this type
-2 - two/0
-1 - three/0
-0 - one/0
+2 - two/0 []
+1 - three/0 []
+0 - one/0 []
3 functors in this type
-2 - two/0
-1 - three/0
-0 - one/0
+2 - two/0 []
+1 - three/0 []
+0 - one/0 []
2 functors in this type
-1 - banana/1
-0 - apple/1
+1 - banana/1 [banana_list]
+0 - apple/1 [apple_list]
2 functors in this type
-1 - banana/1
-0 - apple/1
+1 - banana/1 [banana_list]
+0 - apple/1 [apple_list]
11 functors in this type
-10 - zop/2
-9 - zoom/1
-8 - zip/2
-7 - zap/2
-6 - wombat/0
-5 - qux/1
-4 - quux/1
-3 - quuux/2
-2 - foo/0
-1 - bar/2
-0 - bar/1
+10 - zop/2 [_, _]
+9 - zoom/1 [_]
+8 - zip/2 [_, _]
+7 - zap/2 [_, _]
+6 - wombat/0 []
+5 - qux/1 [_]
+4 - quux/1 [_]
+3 - quuux/2 [_, _]
+2 - foo/0 []
+1 - bar/2 [_, _]
+0 - bar/1 [_]
11 functors in this type
-10 - zop/2
-9 - zoom/1
-8 - zip/2
-7 - zap/2
-6 - wombat/0
-5 - qux/1
-4 - quux/1
-3 - quuux/2
-2 - foo/0
-1 - bar/2
-0 - bar/1
+10 - zop/2 [_, _]
+9 - zoom/1 [_]
+8 - zip/2 [_, _]
+7 - zap/2 [_, _]
+6 - wombat/0 []
+5 - qux/1 [_]
+4 - quux/1 [_]
+3 - quuux/2 [_, _]
+2 - foo/0 []
+1 - bar/2 [_, _]
+0 - bar/1 [_]
11 functors in this type
-10 - zop/2
-9 - zoom/1
-8 - zip/2
-7 - zap/2
-6 - wombat/0
-5 - qux/1
-4 - quux/1
-3 - quuux/2
-2 - foo/0
-1 - bar/2
-0 - bar/1
+10 - zop/2 [_, _]
+9 - zoom/1 [_]
+8 - zip/2 [_, _]
+7 - zap/2 [_, _]
+6 - wombat/0 []
+5 - qux/1 [_]
+4 - quux/1 [_]
+3 - quuux/2 [_, _]
+2 - foo/0 []
+1 - bar/2 [_, _]
+0 - bar/1 [_]
11 functors in this type
-10 - zop/2
-9 - zoom/1
-8 - zip/2
-7 - zap/2
-6 - wombat/0
-5 - qux/1
-4 - quux/1
-3 - quuux/2
-2 - foo/0
-1 - bar/2
-0 - bar/1
+10 - zop/2 [_, _]
+9 - zoom/1 [_]
+8 - zip/2 [_, _]
+7 - zap/2 [_, _]
+6 - wombat/0 []
+5 - qux/1 [_]
+4 - quux/1 [_]
+3 - quuux/2 [_, _]
+2 - foo/0 []
+1 - bar/2 [_, _]
+0 - bar/1 [_]
11 functors in this type
-10 - zop/2
-9 - zoom/1
-8 - zip/2
-7 - zap/2
-6 - wombat/0
-5 - qux/1
-4 - quux/1
-3 - quuux/2
-2 - foo/0
-1 - bar/2
-0 - bar/1
+10 - zop/2 [_, _]
+9 - zoom/1 [_]
+8 - zip/2 [_, _]
+7 - zap/2 [_, _]
+6 - wombat/0 []
+5 - qux/1 [_]
+4 - quux/1 [_]
+3 - quuux/2 [_, _]
+2 - foo/0 []
+1 - bar/2 [_, _]
+0 - bar/1 [_]
TESTING POLYMORPHISM
4 functors in this type
-3 - poly_two/1
-2 - poly_three/3
-1 - poly_one/1
-0 - poly_four/2
+3 - poly_two/1 [_]
+2 - poly_three/3 [_, _, _]
+1 - poly_one/1 [_]
+0 - poly_four/2 [_, _]
4 functors in this type
-3 - poly_two/1
-2 - poly_three/3
-1 - poly_one/1
-0 - poly_four/2
+3 - poly_two/1 [_]
+2 - poly_three/3 [_, _, _]
+1 - poly_one/1 [_]
+0 - poly_four/2 [_, _]
4 functors in this type
-3 - poly_two/1
-2 - poly_three/3
-1 - poly_one/1
-0 - poly_four/2
+3 - poly_two/1 [_]
+2 - poly_three/3 [_, _, _]
+1 - poly_one/1 [_]
+0 - poly_four/2 [_, _]
@@ -159,32 +159,32 @@
1 functors in this type
-0 - {}/4
+0 - {}/4 [_, _, _, _]
TESTING OTHER TYPES
1 functors in this type
-0 - var/1
+0 - var/1 [_]
1 functors in this type
-0 - var_supply/1
+0 - var_supply/1 [_]
1 functors in this type
-0 - var_supply/1
+0 - var_supply/1 [_]
4 functors in this type
-3 - two/4
-2 - three/7
-1 - four/10
-0 - empty/0
+3 - two/4 [_, _, _, _]
+2 - three/7 [_, _, _, _, _, _, _]
+1 - four/10 [_, _, _, _, _, _, _, _, _, _]
+0 - empty/0 []
1 functors in this type
-0 - qwerty/1
+0 - qwerty/1 [qwerty_field]
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list