[m-rev.] for review: improperly initialised rtti structures in java

Peter Wang novalazy at gmail.com
Thu Jun 25 15:25:21 AEST 2009


Branches: main

The Java backend was sometimes generating code like this to initialise RTTI
data structures:

    foo_type_info.init(...,
        /* cast */ new TypeInfo_Struct(bar_type_ctor_info), ...);
    bar_type_ctor_info.init(...);

where `bar_type_ctor_info' is actually a type_info.

The problem is that the fields of the non-initialised `bar_type_ctor_info'
would be copied into the new TypeInfo_Struct object.  The "cast" is of course
also unnecessary as the bar is already a TypeInfo_Struct.

This patch attempts to fix the problem in two ways:

1. Don't allocate a new TypeInfo_Struct object to emulate the "cast" unless the
value is actually a TypeCtorInfo_Struct, avoiding the problem of copying
uninitialised fields.  Currently this is implemented by a runtime check because
the MLDS `cast' operation doesn't record the original type of the value being
cast.

2. Instead of relying on mlds_to_rtti.m to return a list of RTTI data
structures where sub-structures appear before the structures that reference
them, explicitly perform a topological sort.  This should be more robust.


Unrelated change: use pre-allocated PseudoTypeInfo instances for common
variable numbers (1 through 5).


compiler/rtti_to_mlds.m:
        Add a function to order a list of RTTI definitions as above.

        Use cons instead of list.append in some places now that we can.

compiler/mlds_to_java.m:
        Call the function to order RTTI definitions before outputing
        the initialisations.

        Call TypeInfo_Struct.maybe_new instead of allocating new
        TypeInfo_Structs.

        Generate code that uses pre-allocated PseudoTypeInfo instances.

java/runtime/TypeInfo_Struct.java:
        Add a `maybe_new' method for "casting" TypeCtorInfo_Structs to
        TypeInfos or returning the argument unchanged.

        Delete a copy constructor; now unused.

        Add some assertions.

java/runtime/PseudoTypeInfo.java:
        Add static instances of PseudoTypeInfo.

tests/hard_coded/Mmakefile:
tests/hard_coded/java_rtti_bug.exp:
tests/hard_coded/java_rtti_bug.m:
        Add test case.

diff --git a/compiler/mlds_to_java.m b/compiler/mlds_to_java.m
index 0c7a995..bd22bc6 100644
--- a/compiler/mlds_to_java.m
+++ b/compiler/mlds_to_java.m
@@ -98,6 +98,7 @@
 :- import_module ml_backend.ml_code_util.  % for ml_gen_local_var_decl_flags.
 :- import_module ml_backend.ml_type_gen.   % for ml_gen_type_name
 :- import_module ml_backend.ml_util.
+:- import_module ml_backend.rtti_to_mlds.
 :- import_module parse_tree.builtin_lib_types.
 :- import_module parse_tree.file_names.    % for mercury_std_library_name.
 :- import_module parse_tree.java_names.
@@ -1752,15 +1753,27 @@ output_rtti_assignments(Indent, ModuleInfo,
ModuleName, Defns, !IO) :-
         Defns = []
     ;
         Defns = [_ | _],
+        OrderedDefns = order_mlds_rtti_defns(Defns),
         indent_line(Indent, !IO),
         io.write_string("static {\n", !IO),
         list.foldl(
-            output_rtti_defn_assignments(Indent + 1, ModuleInfo, ModuleName),
-            Defns, !IO),
+            output_rtti_defns_assignments(Indent + 1, ModuleInfo, ModuleName),
+            OrderedDefns, !IO),
         indent_line(Indent, !IO),
         io.write_string("}\n", !IO)
     ).

+:- pred output_rtti_defns_assignments(indent::in, module_info::in,
+    mlds_module_name::in, list(mlds_defn)::in, io::di, io::uo) is det.
+
+output_rtti_defns_assignments(Indent, ModuleInfo, ModuleName, Defns, !IO) :-
+    % Separate cliques.
+    indent_line(Indent, !IO),
+    io.write_string("//\n", !IO),
+    list.foldl(
+        output_rtti_defn_assignments(Indent, ModuleInfo, ModuleName),
+        Defns, !IO).
+
 :- pred output_rtti_defn_assignments(indent::in, module_info::in,
     mlds_module_name::in, mlds_defn::in, io::di, io::uo) is det.

@@ -3414,19 +3427,27 @@ output_unop(ModuleInfo, Unop, Expr, ModuleName, !IO) :-
         % Similarly for conversions from TypeCtorInfo to TypeInfo.
         (
             Type = mlds_pseudo_type_info_type,
-            Expr = ml_const(mlconst_int(_))
+            Expr = ml_const(mlconst_int(N))
         ->
             maybe_output_comment("cast", !IO),
-            io.write_string("new jmercury.runtime.PseudoTypeInfo(", !IO),
-            output_rval(ModuleInfo, Expr, ModuleName, !IO),
-            io.write_string(")", !IO)
+            ( have_preallocated_pseudo_type_var(N) ->
+                io.write_string("jmercury.runtime.PseudoTypeInfo.K", !IO),
+                io.write_int(N, !IO)
+            ;
+                io.write_string("new jmercury.runtime.PseudoTypeInfo(", !IO),
+                output_rval(ModuleInfo, Expr, ModuleName, !IO),
+                io.write_string(")", !IO)
+            )
         ;
             ( Type = mercury_type(_, ctor_cat_system(cat_system_type_info), _)
             ; Type = mlds_type_info_type
             )
         ->
+            % XXX we really should be able to tell if we are casting a
+            % TypeCtorInfo or a TypeInfo
             maybe_output_comment("cast", !IO),
-            io.write_string("new jmercury.runtime.TypeInfo_Struct(", !IO),
+            io.write_string("jmercury.runtime.TypeInfo_Struct.maybe_new(",
+                !IO),
             output_rval(ModuleInfo, Expr, ModuleName, !IO),
             io.write_string(")", !IO)
         ;
@@ -3443,6 +3464,13 @@ output_unop(ModuleInfo, Unop, Expr, ModuleName, !IO) :-
         output_std_unop(ModuleInfo, StdUnop, Expr, ModuleName, !IO)
     ).

+:- pred have_preallocated_pseudo_type_var(int::in) is semidet.
+
+have_preallocated_pseudo_type_var(N) :-
+    % Corresponds to static members in class PseudoTypeInfo.
+    N >= 1,
+    N =< 5.
+
 :- pred output_cast_rval(module_info::in, mlds_type::in, mlds_rval::in,
     mlds_module_name::in, io::di, io::uo) is det.

diff --git a/compiler/rtti_to_mlds.m b/compiler/rtti_to_mlds.m
index 3a933a2..4e65bef 100644
--- a/compiler/rtti_to_mlds.m
+++ b/compiler/rtti_to_mlds.m
@@ -14,26 +14,6 @@
 % The RTTI data structures are used for static data that is used
 % for handling RTTI, polymorphism, and typeclasses.
 %
-% XXX There are problems with these definitions for the Java back-end.
-% Under the current system, the definitions are output as static variables
-% with static initializers, ordered so that subdefinitions always appear before
-% the definition which uses them.  This is neccessary because in Java, static
-% initializers are performed at runtime in textual order, and if a definition
-% relies on another static variable for its constructor but said variable has
-% not been initialized, then it is treated as `null' by the JVM with no
-% warning.
-% The problem with this approach is that it won't work for cyclic definitions.
-% eg:
-%   :- type foo ---> f(bar) ; g.
-%   :- type bar ---> f2(foo) ; g2
-% At some point this should be changed so that initialization is performed by 2
-% phases: first allocate all of the objects, then fill in the fields.
-%
-% XXX In the absence of this fix, there are still several places in the code
-% below which use list.append.  If possible these lists should instead be
-% manipulated through some use of prepending and/or list.reverse instead, so
-% that the algorithm stays O(N).
-%
 %-----------------------------------------------------------------------------%

 :- module ml_backend.rtti_to_mlds.
@@ -51,6 +31,15 @@
     %
 :- func rtti_data_list_to_mlds(module_info, list(rtti_data)) = list(mlds_defn).

+    % Given a list of MLDS RTTI data definitions (only), return the definitions
+    % such that if X appears in the initialiser for Y then X appears earlier in
+    % the list than Y.
+    %
+    % This function returns a list of cliques so that problems with ordering
+    % within cliques, if any, may be easier to discover.
+    %
+:- func order_mlds_rtti_defns(list(mlds_defn)) = list(list(mlds_defn)).
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%

@@ -72,11 +61,14 @@
 :- import_module assoc_list.
 :- import_module bool.
 :- import_module counter.
+:- import_module digraph.
 :- import_module int.
 :- import_module list.
 :- import_module map.
 :- import_module maybe.
 :- import_module pair.
+:- import_module set.
+:- import_module svmap.
 :- import_module term.
 :- import_module univ.

@@ -117,7 +109,7 @@ rtti_data_to_mlds(ModuleInfo, RttiData) = MLDS_Defns :-
             Initializer, ExtraDefns),
         rtti_entity_name_and_init_to_defn(Name, RttiId, Initializer,
             MLDS_Defn),
-        MLDS_Defns = ExtraDefns ++ [MLDS_Defn]
+        MLDS_Defns = [MLDS_Defn | ExtraDefns]
     ).

 :- pred rtti_name_and_init_to_defn(rtti_type_ctor::in, ctor_rtti_name::in,
@@ -339,7 +331,7 @@ gen_type_class_decl_defn(TCDecl, RttiId,
ModuleInfo, Init, SubDefns) :-
         SuperArrayInit = gen_init_array(
             gen_init_cast_rtti_id(ElementType, ModuleName), SuperRttiIds),
         rtti_id_and_init_to_defn(SuperArrayRttiId, SuperArrayInit, SuperDefn),
-        SuperDefns = SuperConstrDefns ++ [SuperDefn],
+        SuperDefns = [SuperDefn | SuperConstrDefns],
         SupersInit = gen_init_null_pointer(
             mlds_rtti_type(item_type(MethodIdsRttiId)))
     ),
@@ -538,7 +530,7 @@ gen_functors_layout_info(ModuleInfo, RttiTypeCtor,
TypeCtorDetails,
             type_ctor_enum_name_ordered_table),
         NumberMapInit = gen_init_rtti_name(ModuleName, RttiTypeCtor,
             type_ctor_functor_number_map),
-        Defns = EnumFunctorDescs ++ [ByValueDefn, ByNameDefn, NumberMapDefn]
+        Defns = [ByValueDefn, ByNameDefn, NumberMapDefn | EnumFunctorDescs]
     ;
         TypeCtorDetails = tcd_foreign_enum(ForeignEnumLang, _,
             ForeignEnumFunctors, ForeignEnumByOrdinal, ForeignEnumByName,
@@ -558,8 +550,8 @@ gen_functors_layout_info(ModuleInfo, RttiTypeCtor,
TypeCtorDetails,
             type_ctor_foreign_enum_name_ordered_table),
         NumberMapInit = gen_init_rtti_name(ModuleName, RttiTypeCtor,
             type_ctor_functor_number_map),
-        Defns = ForeignEnumFunctorDescs ++
-            [ByOrdinalDefn, ByNameDefn, NumberMapDefn]
+        Defns = [ByOrdinalDefn, ByNameDefn, NumberMapDefn |
+            ForeignEnumFunctorDescs]
     ;
         TypeCtorDetails = tcd_du(_, DuFunctors, DuByPtag, DuByName,
             FunctorNumberMap),
@@ -673,7 +665,7 @@ gen_notag_functor_desc(ModuleInfo, RttiTypeCtor,
NotagFunctorDesc)
         gen_init_maybe(ml_string_type, gen_init_string, MaybeArgName)
     ]),
     rtti_id_and_init_to_defn(RttiId, Init, MLDS_Defn),
-    MLDS_Defns = SubDefns ++ [MLDS_Defn].
+    MLDS_Defns = [MLDS_Defn | SubDefns].

 :- func gen_du_functor_desc(module_info, rtti_type_ctor, du_functor)
     = list(mlds_defn).
@@ -758,7 +750,7 @@ gen_du_functor_desc(ModuleInfo, RttiTypeCtor,
DuFunctor) = MLDS_Defns :-
         ExistInfoInit
     ]),
     rtti_id_and_init_to_defn(RttiId, Init, MLDS_Defn),
-    MLDS_Defns = SubDefns ++ [MLDS_Defn].
+    MLDS_Defns = [MLDS_Defn | SubDefns].

 :- func gen_res_addr_functor_desc(module_info, rtti_type_ctor,
     reserved_functor) = mlds_defn.
@@ -835,7 +827,7 @@ gen_tc_constraint(ModuleInfo, MakeRttiId,
Constraint, RttiId, !Counter,
         PTIInits
     ]),
     rtti_id_and_init_to_defn(RttiId, Init, ConstrDefn),
-    !:Defns = !.Defns ++ PTIDefns ++ [ConstrDefn].
+    !:Defns = !.Defns ++ [ConstrDefn | PTIDefns].

 :- pred make_exist_tc_constr_id(rtti_type_ctor::in, int::in, int::in, int::in,
     rtti_id::out) is det.
@@ -875,7 +867,7 @@ gen_exist_info(ModuleInfo, RttiTypeCtor, Ordinal,
ExistInfo) = MLDS_Defns :-
             gen_init_cast_rtti_id(ElementType, ModuleName), TCConstrIds),
         rtti_name_and_init_to_defn(RttiTypeCtor, TCConstrArrayRttiName,
             TCConstrArrayInit, TCConstrArrayDefn),
-        ConstrDefns = TCConstrDefns ++ [TCConstrArrayDefn]
+        ConstrDefns = [TCConstrArrayDefn | TCConstrDefns]
     ),
     Init = init_struct(mlds_rtti_type(item_type(RttiId)), [
         gen_init_int(Plain),
@@ -913,7 +905,7 @@ gen_field_types(ModuleInfo, RttiTypeCtor, Ordinal,
Types) = MLDS_Defns :-
     gen_pseudo_type_info_array(ModuleInfo, TypeRttiDatas, Init, SubDefns),
     RttiName = type_ctor_field_types(Ordinal),
     rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Init, MLDS_Defn),
-    MLDS_Defns = SubDefns ++ [MLDS_Defn].
+    MLDS_Defns = [MLDS_Defn | SubDefns].

 %-----------------------------------------------------------------------------%

@@ -1009,7 +1001,7 @@ gen_du_ptag_ordered_table(ModuleInfo,
RttiTypeCtor, PtagMap) = MLDS_Defns :-
     RttiName = type_ctor_du_ptag_ordered_table,
     Init = init_array(PtagInitPrefix ++ PtagInits),
     rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Init, MLDS_Defn),
-    MLDS_Defns = SubDefns ++ [MLDS_Defn].
+    MLDS_Defns = [MLDS_Defn | SubDefns].

 :- func gen_du_ptag_ordered_table_body(module_name, rtti_type_ctor,
     assoc_list(int, sectag_table), int) = list(mlds_initializer).
@@ -1095,7 +1087,7 @@ gen_maybe_res_value_ordered_table(ModuleInfo,
RttiTypeCtor, ResFunctors,
             type_ctor_du_ptag_ordered_table)
     ]),
     rtti_id_and_init_to_defn(RttiId, Init, MLDS_Defn),
-    MLDS_Defns = SubDefns ++ [MLDS_Defn].
+    MLDS_Defns = [MLDS_Defn | SubDefns].

 :- func gen_res_addr_functor_table(module_name, rtti_type_ctor,
     list(reserved_functor)) = mlds_defn.
@@ -1566,6 +1558,148 @@ gen_init_type_ctor_rep(TypeCtorData) =
gen_init_builtin_const(Name) :-
     rtti.type_ctor_rep_to_string(TypeCtorData, Name).

 %-----------------------------------------------------------------------------%
+%
+% Ordering RTTI definitions
+%
+
+order_mlds_rtti_defns(Defns) = OrdDefns :-
+    some [!Graph] (
+        digraph.init(!:Graph),
+        list.foldl2(add_rtti_defn_nodes, Defns, !Graph, map.init, NameMap),
+        list.foldl(add_rtti_defn_arcs, Defns, !Graph),
+        digraph.atsort(!.Graph, RevOrdSets)
+    ),
+    list.reverse(RevOrdSets, OrdSets),
+    list.map(set.to_sorted_list, OrdSets, OrdLists),
+    list.map(list.filter_map(map.search(NameMap)), OrdLists, OrdDefns).
+
+:- pred add_rtti_defn_nodes(mlds_defn::in,
+    digraph(mlds_data_name)::in, digraph(mlds_data_name)::out,
+    map(mlds_data_name, mlds_defn)::in, map(mlds_data_name, mlds_defn)::out)
+    is det.
+
+add_rtti_defn_nodes(Defn, !Graph, !NameMap) :-
+    Name = Defn ^ mlds_entity_name,
+    (
+        Name = entity_data(DataName),
+        digraph.add_vertex(DataName, _, !Graph),
+        svmap.det_insert(DataName, Defn, !NameMap)
+    ;
+        ( Name = entity_type(_, _)
+        ; Name = entity_function(_, _, _, _)
+        ; Name = entity_export(_)
+        ),
+        unexpected(this_file, "add_rtti_defn_nodes: expected entity_data")
+    ).
+
+:- pred add_rtti_defn_arcs(mlds_defn::in,
+    digraph(mlds_data_name)::in, digraph(mlds_data_name)::out) is det.
+
+add_rtti_defn_arcs(Defn, !Graph) :-
+    Defn = mlds_defn(EntityName, _, _, EntityDefn),
+    (
+        EntityName = entity_data(DefnDataName),
+        EntityDefn = mlds_data(Type, Initializer, _GCStatement),
+        Type = mlds_rtti_type(_)
+    ->
+        add_rtti_defn_arcs_initializer(DefnDataName, Initializer, !Graph)
+    ;
+        unexpected(this_file, "add_rtti_defn_arcs: expected rtti entity_data")
+    ).
+
+:- pred add_rtti_defn_arcs_initializer(mlds_data_name::in,
mlds_initializer::in,
+    digraph(mlds_data_name)::in, digraph(mlds_data_name)::out) is det.
+
+add_rtti_defn_arcs_initializer(DefnDataName, Initializer, !Graph) :-
+    (
+        Initializer = init_obj(Rval),
+        add_rtti_defn_arcs_rval(DefnDataName, Rval, !Graph)
+    ;
+        ( Initializer = init_struct(_, Initializers)
+        ; Initializer = init_array(Initializers)
+        ),
+        list.foldl(add_rtti_defn_arcs_initializer(DefnDataName), Initializers,
+            !Graph)
+    ;
+        Initializer = no_initializer
+    ).
+
+:- pred add_rtti_defn_arcs_rval(mlds_data_name::in, mlds_rval::in,
+    digraph(mlds_data_name)::in, digraph(mlds_data_name)::out) is det.
+
+add_rtti_defn_arcs_rval(DefnDataName, Rval, !Graph) :-
+    (
+        Rval = ml_lval(Lval),
+        add_rtti_defn_arcs_lval(DefnDataName, Lval, !Graph)
+    ;
+        Rval = ml_mkword(_Tag, RvalA),
+        add_rtti_defn_arcs_rval(DefnDataName, RvalA, !Graph)
+    ;
+        Rval = ml_const(Const),
+        add_rtti_defn_arcs_const(DefnDataName, Const, !Graph)
+    ;
+        Rval = ml_unop(_, RvalA),
+        add_rtti_defn_arcs_rval(DefnDataName, RvalA, !Graph)
+    ;
+        Rval = ml_binop(_, RvalA, RvalB),
+        add_rtti_defn_arcs_rval(DefnDataName, RvalA, !Graph),
+        add_rtti_defn_arcs_rval(DefnDataName, RvalB, !Graph)
+    ;
+        Rval = ml_mem_addr(Lval),
+        add_rtti_defn_arcs_lval(DefnDataName, Lval, !Graph)
+    ;
+        Rval = ml_self(_)
+    ).
+
+:- pred add_rtti_defn_arcs_lval(mlds_data_name::in, mlds_lval::in,
+    digraph(mlds_data_name)::in, digraph(mlds_data_name)::out) is det.
+
+add_rtti_defn_arcs_lval(DefnDataName, Lval, !Graph) :-
+    (
+        Lval = ml_field(_, Rval, _, _, _),
+        add_rtti_defn_arcs_rval(DefnDataName, Rval, !Graph)
+    ;
+        Lval = ml_mem_ref(Rval, _Type),
+        add_rtti_defn_arcs_rval(DefnDataName, Rval, !Graph)
+    ;
+        Lval = ml_global_var_ref(env_var_ref(_))
+    ;
+        Lval = ml_var(_, _)
+    ).
+
+:- pred add_rtti_defn_arcs_const(mlds_data_name::in, mlds_rval_const::in,
+    digraph(mlds_data_name)::in, digraph(mlds_data_name)::out) is det.
+
+add_rtti_defn_arcs_const(DefnDataName, Const, !Graph) :-
+    (
+        Const = mlconst_data_addr(data_addr(_, DataName)),
+        (
+            DataName = mlds_rtti(_),
+            digraph.add_vertices_and_edge(DefnDataName, DataName, !Graph)
+        ;
+            ( DataName = mlds_data_var(_)
+            ; DataName = mlds_common(_)
+            ; DataName = mlds_module_layout
+            ; DataName = mlds_proc_layout(_)
+            ; DataName = mlds_internal_layout(_, _)
+            ; DataName = mlds_tabling_ref(_, _)
+            )
+        )
+    ;
+        ( Const = mlconst_true
+        ; Const = mlconst_false
+        ; Const = mlconst_int(_)
+        ; Const = mlconst_foreign(_, _, _)
+        ; Const = mlconst_float(_)
+        ; Const = mlconst_string(_)
+        ; Const = mlconst_multi_string(_)
+        ; Const = mlconst_named_const(_)
+        ; Const = mlconst_code_addr(_)
+        ; Const = mlconst_null(_)
+        )
+    ).
+
+%-----------------------------------------------------------------------------%

 :- func this_file = string.

diff --git a/java/runtime/PseudoTypeInfo.java b/java/runtime/PseudoTypeInfo.java
index 89b807a..318f360 100644
--- a/java/runtime/PseudoTypeInfo.java
+++ b/java/runtime/PseudoTypeInfo.java
@@ -1,5 +1,5 @@
 //
-// Copyright (C) 2001-2004 The University of Melbourne.
+// Copyright (C) 2001-2004, 2009 The University of Melbourne.
 // This file may only be copied under the terms of the GNU Library General
 // Public License - see the file COPYING.LIB in the Mercury distribution.
 //
@@ -26,6 +26,14 @@ public class PseudoTypeInfo {
 	public    PseudoTypeInfo(int n) { variable_number = n; }
 	protected PseudoTypeInfo()      { variable_number = -1; }

+	// Adding or removing members requires corresponding changes in
+	// mlds_to_java.m.
+	public static final PseudoTypeInfo K1 = new PseudoTypeInfo(1);
+	public static final PseudoTypeInfo K2 = new PseudoTypeInfo(2);
+	public static final PseudoTypeInfo K3 = new PseudoTypeInfo(3);
+	public static final PseudoTypeInfo K4 = new PseudoTypeInfo(4);
+	public static final PseudoTypeInfo K5 = new PseudoTypeInfo(5);
+
 		// XXX This should be renamed `equals'
 	public boolean unify(PseudoTypeInfo ti) {
 		if (this.getClass() == TypeInfo_Struct.class &&
@@ -36,3 +44,5 @@ public class PseudoTypeInfo {
 		return variable_number == ti.variable_number;
 	}
 }
+
+// vim: set ts=8 sts=8 sw=8 noet:
diff --git a/java/runtime/TypeInfo_Struct.java
b/java/runtime/TypeInfo_Struct.java
index 107d59e..688b860 100644
--- a/java/runtime/TypeInfo_Struct.java
+++ b/java/runtime/TypeInfo_Struct.java
@@ -18,22 +18,36 @@ public class TypeInfo_Struct extends PseudoTypeInfo {
 	public TypeInfo_Struct(TypeCtorInfo_Struct tc)
 	{
 		type_ctor = tc;
+		sanity_check();
 	}

-	// copy constructor
-	// XXX Rather than invoking this constructor, and allocating a new
-	//     type_info object on the heap, we should generate code which
-	//     just copies the pointer,
-	public TypeInfo_Struct(TypeInfo_Struct ti)
+	public static TypeInfo_Struct maybe_new(final Object obj)
 	{
-		type_ctor = ti.type_ctor;
-		args = ti.args;
+		// In at least one place in the standard library we make up a
+		// TypeInfo out of thin air to satisfy the compiler.
+		if (obj == null) {
+			return null;
+		}
+		if (obj instanceof TypeInfo_Struct) {
+			return (TypeInfo_Struct) obj;
+		}
+		if (obj instanceof TypeCtorInfo_Struct) {
+			return new TypeInfo_Struct((TypeCtorInfo_Struct) obj);
+		}
+		throw new java.lang.Error(
+			"expected TypeInfo_Struct or TypeCtorInfo_Struct");
 	}

 	public void init(TypeCtorInfo_Struct tc, PseudoTypeInfo[] as)
 	{
-	    type_ctor = tc;
-	    args = as;
+		type_ctor = tc;
+		args = as;
+
+		// We may be in the middle of initialising a cyclic data
+		// structure, so unfortunately, we can't actually sanity check
+		// the arguments here.
+		assert tc != null;
+		// sanity_check();
 	}

 	public TypeInfo_Struct copy()
@@ -43,6 +57,7 @@ public class TypeInfo_Struct extends PseudoTypeInfo {
 		if (args != null) {
 			ti.args = args.clone();
 		}
+		ti.sanity_check();
 		return ti;
 	}

@@ -119,4 +134,27 @@ public class TypeInfo_Struct extends PseudoTypeInfo {
 		}
 		return true;
 	}
+
+	private void sanity_check() {
+		assert type_ctor != null;
+
+		if (args == null) {
+			return;
+		}
+		for (PseudoTypeInfo pti : args) {
+			if (pti instanceof TypeInfo_Struct) {
+				TypeInfo_Struct ti = (TypeInfo_Struct) pti;
+				assert ti.type_ctor != null;
+				assert ti.variable_number == -1;
+			} else if (pti instanceof TypeCtorInfo_Struct) {
+				TypeCtorInfo_Struct tc =
+					(TypeCtorInfo_Struct) pti;
+				assert tc.variable_number == -1;
+			} else {
+				assert pti.variable_number != -1;
+			}
+		}
+	}
 }
+
+// vim: set ts=8 sw=8 sts=8 noet:
diff --git a/tests/hard_coded/Mmakefile b/tests/hard_coded/Mmakefile
index ab64a7d..6271558 100644
--- a/tests/hard_coded/Mmakefile
+++ b/tests/hard_coded/Mmakefile
@@ -139,6 +139,7 @@ ORDINARY_PROGS=	\
 	intermod_pragma_clause \
 	intermod_type_qual \
 	intermod_unused_args \
+	java_rtti_bug \
 	join_list \
 	lco_no_inline \
 	list_series_int \
diff --git a/tests/hard_coded/java_rtti_bug.exp
b/tests/hard_coded/java_rtti_bug.exp
new file mode 100644
index 0000000..c9be995
--- /dev/null
+++ b/tests/hard_coded/java_rtti_bug.exp
@@ -0,0 +1 @@
+foo(bar(baz(1)))
diff --git a/tests/hard_coded/java_rtti_bug.m b/tests/hard_coded/java_rtti_bug.m
new file mode 100644
index 0000000..09fde50
--- /dev/null
+++ b/tests/hard_coded/java_rtti_bug.m
@@ -0,0 +1,33 @@
+% Regression test.
+% The Java backend was generating code that didn't initialise an type_ctor_info
+% before another RTTI structure referenced it.  This resulted in a null
+% pointer exception when this program is executed.
+
+:- module java_rtti_bug.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+main(!IO) :-
+    X = foo(bar(baz(1))),
+    io.write(X, !IO),
+    io.nl(!IO).
+
+:- type foo
+    --->    foo(bar(baz(int))).
+
+:- type bar(T)
+    --->    bar(T).
+
+:- type baz(T)
+    --->    baz(T).
+
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=8 sts=4 sw=4 et
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------



More information about the reviews mailing list