[m-rev.] for review: Fix inst for constant type_infos.

[Peter Wang]

The inst for type_infos entered into the const_struct database did not
count the type_ctor_info argument, thus the cons_id arity was off by one.
Bug #297.

compiler/polymorphism.m:
        Account for the type_ctor_info when making the inst for a constant
        type_info.

tests/hard_coded/Mercury.options:
tests/hard_coded/Mmakefile:
tests/hard_coded/type_info_const_inst.exp:
tests/hard_coded/type_info_const_inst.m:
        Add test case.
---
 compiler/polymorphism.m                   |  2 +-
 tests/hard_coded/Mercury.options          |  1 +
 tests/hard_coded/Mmakefile                |  1 +
 tests/hard_coded/type_info_const_inst.exp |  2 ++
 tests/hard_coded/type_info_const_inst.m   | 54 +++++++++++++++++++++++++++++++
 5 files changed, 59 insertions(+), 1 deletion(-)
 create mode 100644 tests/hard_coded/type_info_const_inst.exp
 create mode 100644 tests/hard_coded/type_info_const_inst.m

diff --git a/compiler/polymorphism.m b/compiler/polymorphism.m
index 908d26e..13f24ae 100644
--- a/compiler/polymorphism.m
+++ b/compiler/polymorphism.m
@@ -3346,7 +3346,7 @@ polymorphism_construct_type_info(Type, TypeCtor, TypeArgs, TypeCtorIsVarArity,
                 StructArgInsts = [TypeCtorInst | ArgTypeInfoInsts]
             ),
             StructType = type_info_type,
-            list.length(ArgTypeInfoConstArgs, NumArgs),
+            list.length(StructConstArgs, NumArgs),
             InstConsId = cell_inst_cons_id(Cell, NumArgs),
             StructInst = bound(shared, inst_test_results_fgtc,
                 [bound_functor(InstConsId, StructArgInsts)]),
diff --git a/tests/hard_coded/Mercury.options b/tests/hard_coded/Mercury.options
index 2dbcab4..2de5c6e 100644
--- a/tests/hard_coded/Mercury.options
+++ b/tests/hard_coded/Mercury.options
@@ -72,6 +72,7 @@ MCFLAGS-reuse_ho            =	--ctgc --no-optimise-higher-order
 MCFLAGS-sharing_comb	    =	--ctgc --structure-sharing-widening 2
 MCFLAGS-simplify_multi_arm_switch = -O3
 MCFLAGS-string_substring    =	--no-warn-obsolete
+MCFLAGS-type_info_const_inst	= --const-struct --optimise-constant-propagation
 MCFLAGS-uncond_reuse	    =	--ctgc
 MCFLAGS-uncond_reuse_bad    =	--ctgc
 MCFLAGS-uo_regression1      =	--from-ground-term-threshold=4
diff --git a/tests/hard_coded/Mmakefile b/tests/hard_coded/Mmakefile
index acecc02..23e922b 100644
--- a/tests/hard_coded/Mmakefile
+++ b/tests/hard_coded/Mmakefile
@@ -321,6 +321,7 @@ ORDINARY_PROGS=	\
 	tuple_test \
 	type_ctor_desc \
 	type_ctor_desc_manip \
+	type_info_const_inst \
 	type_info_order \
 	type_qual \
 	type_spec_ho_term \
diff --git a/tests/hard_coded/type_info_const_inst.exp b/tests/hard_coded/type_info_const_inst.exp
new file mode 100644
index 0000000..05fd4f7
--- /dev/null
+++ b/tests/hard_coded/type_info_const_inst.exp
@@ -0,0 +1,2 @@
+a,a
+a,b
diff --git a/tests/hard_coded/type_info_const_inst.m b/tests/hard_coded/type_info_const_inst.m
new file mode 100644
index 0000000..6c06697
--- /dev/null
+++ b/tests/hard_coded/type_info_const_inst.m
@@ -0,0 +1,54 @@
+% There was a bug in the inst for static type_infos when --const-struct was
+% enabled: the arity was off by one as it did not count the type_ctor_info
+% argument.
+%
+% This made unification with a dynamic type_info (with the correct inst)
+% fail when it shouldn't, at compile-time when --optimise-constant-pbpagation
+% was enabled.
+
+:- module type_info_const_inst.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module require.
+:- import_module string.
+:- import_module type_desc.
+
+:- type thing(T, U)
+    --->    thing(T, U, string).
+
+:- type a
+    --->    a(int, string).
+
+:- type b
+    --->    b(int, int).
+
+main(!IO) :-
+    A = thing(a(1, "2"), a(3, "4"), "A"),
+    describe(A, DescA),
+    io.write_string(DescA, !IO),
+    io.nl(!IO),
+
+    B = thing(a(1, "2"), b(3, 4), "B"),
+    describe(B, DescB),
+    io.write_string(DescB, !IO),
+    io.nl(!IO).
+
+:- pred describe(thing(T, U)::in, string::out) is det.
+
+describe(X, What) :-
+    ( dynamic_cast(X, _ : thing(a, a)) ->
+        What = "a,a"
+    ; dynamic_cast(X, _ : thing(a, b)) ->
+        What = "a,b"
+    ;
+        unexpected($module, $pred, string(type_of(X)))
+    ).
+
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sts=4 sw=4 et
-- 
1.7.12.1