[m-rev.] diff: fix RTTI equivalence type bug
Fergus Henderson
fjh at cs.mu.OZ.AU
Mon Feb 16 13:27:29 AEDT 2004
Estimated hours taken: 3
Branches: main, release
Fix a bug reported by Ondrej Bojar (obo [AT] cuni [DOT] cz)
which caused seg faults in io.read_binary.
library/construct.m:
Expand equivalence types in get_functor/5, get_functor_2/6,
and construct/4. This is needed in order to have the proper
type_info to use when substituting type parameters in the list
of argument types for the functor.
tests/hard_coded/Mmakefile:
tests/hard_coded/construct_bug.m:
tests/hard_coded/construct_bug.exp:
tests/hard_coded/construct_bug_submodule.m:
Add a new regression test.
Workspace: /home/jupiter/fjh/ws-jupiter/mercury
Index: library/construct.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/construct.m,v
retrieving revision 1.14
diff -u -d -r1.14 construct.m
--- library/construct.m 20 Jan 2004 23:03:18 -0000 1.14
+++ library/construct.m 16 Feb 2004 01:55:05 -0000
@@ -120,6 +120,13 @@
type_info = (MR_TypeInfo) TypeDesc;
/*
+ ** If type_info is an equivalence type, expand it.
+ */
+ MR_save_transient_registers();
+ type_info = MR_collapse_equivalences(type_info);
+ MR_restore_transient_registers();
+
+ /*
** Get information for this functor number and
** store in construct_info. If this is a discriminated union
** type and if the functor number is in range, we
@@ -211,6 +218,13 @@
type_info = (MR_TypeInfo) TypeDesc;
/*
+ ** If type_info is an equivalence type, expand it.
+ */
+ MR_save_transient_registers();
+ type_info = MR_collapse_equivalences(type_info);
+ MR_restore_transient_registers();
+
+ /*
** Get information for this functor number and
** store in construct_info. If this is a discriminated union
** type and if the functor number is in range, we
@@ -329,6 +343,13 @@
MR_bool success;
type_info = (MR_TypeInfo) TypeDesc;
+
+ /*
+ ** If type_info is an equivalence type, expand it.
+ */
+ MR_save_transient_registers();
+ type_info = MR_collapse_equivalences(type_info);
+ MR_restore_transient_registers();
/*
** Check range of FunctorNum, get info for this
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.226
diff -u -d -r1.226 Mmakefile
--- tests/hard_coded/Mmakefile 12 Feb 2004 02:30:03 -0000 1.226
+++ tests/hard_coded/Mmakefile 16 Feb 2004 01:38:36 -0000
@@ -28,6 +28,7 @@
constraint \
constraint_order \
construct_test \
+ construct_bug \
contravariance_bug \
contravariance_poly \
curry \
Index: tests/hard_coded/construct_bug.exp
===================================================================
RCS file: tests/hard_coded/construct_bug.exp
diff -N tests/hard_coded/construct_bug.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/construct_bug.exp 16 Feb 2004 02:19:53 -0000
@@ -0,0 +1,3 @@
+Saved the map to file: temp.term
+Loaded the map from file: temp.term
+The representations are identical.
Index: tests/hard_coded/construct_bug.m
===================================================================
RCS file: tests/hard_coded/construct_bug.m
diff -N tests/hard_coded/construct_bug.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/construct_bug.m 16 Feb 2004 01:43:56 -0000
@@ -0,0 +1,76 @@
+% This is a regression test for a bug in construct.get_functor/5,
+% where it was not handling equivalence types properly.
+
+:- module construct_bug.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module list, int, std_util, require, string.
+:- import_module construct_bug_submodule.
+
+main(!IO) :-
+ FileName = "temp.term",
+
+ call(
+ (pred(!.S::in, !:S::out) is det:-
+ count(["A"], !S),
+ count(["A","A2"], !S),
+ count(["B"], !S),
+ count(["B","B1"], !S),
+ count(["B","B2"], !S),
+ count(["B","B3"], !S),
+ count(["C"], !S),
+ count(["C","C1"], !S)
+ ), construct_bug_submodule__init, Map),
+
+ io__open_binary_output(FileName, Result, !IO),
+ (
+ if (Result = ok(Temp___ORDIE___Out___OutStream) )
+ then (OutStream = Temp___ORDIE___Out___OutStream, true)
+ else error( "Failed to write to '"++FileName++"'.")
+ ),
+ io__write_binary(OutStream, Map, !IO),
+ close_binary_output(OutStream, !IO),
+
+ io__write_string("Saved the map to file: "++FileName++"\n", !IO),
+
+ io__open_binary_input(FileName, Result2, !IO),
+ (
+ if (Result2 = ok(Temp___ORDIE___Out___InStream) )
+ then (InStream = Temp___ORDIE___Out___InStream, true)
+ else error( "Failed to open '"++FileName++"'.")
+ ),
+ io__read_binary(InStream, MayDataTerm, !IO),
+ io__close_binary_input(InStream, !IO),
+ (
+ MayDataTerm = ok(ReadMap`with_type`stat)
+ ; MayDataTerm = eof,
+ error("Unexpected end of file: '"++FileName++"'.")
+ ; MayDataTerm = error(E),
+ error("Error reading term from: '"++FileName++"': "
+ ++io__error_message(E)++".")
+ ),
+
+ io__write_string("Loaded the map from file: "++FileName++"\n", !IO),
+
+ (
+ if Map = ReadMap
+ then
+ io__write_string("The representations are identical.\n", !IO)
+ else
+ io__write_string("The representations are different.\n", !IO)
+ ),
+
+ io__remove_file(FileName, RmResult, !IO),
+ ( RmResult = ok
+ ; RmResult = error(E2),
+ error("Error deleting file '"++FileName++"': "
+ ++io__error_message(E2)++".")
+ ).
+
Index: tests/hard_coded/construct_bug_submodule.m
===================================================================
RCS file: tests/hard_coded/construct_bug_submodule.m
diff -N tests/hard_coded/construct_bug_submodule.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/construct_bug_submodule.m 16 Feb 2004 01:40:18 -0000
@@ -0,0 +1,196 @@
+% This is part of the construct_bug test case.
+:- module construct_bug_submodule.
+
+:- interface.
+
+:- import_module string, list, int, assoc_list.
+
+:- type stat.
+:- type statkey == list(string).
+
+:- func init = (stat::out) is det.
+:- func blank = (stat::out) is det.
+
+:- pred count(statkey, stat, stat).
+:- mode count(in, in, out) is det.
+
+:- pred count(int, statkey, stat, stat).
+:- mode count(in, in, in, out) is det.
+
+% Same as count/4, just reversed the first two args
+:- pred count_more(statkey, int, stat, stat).
+:- mode count_more(in, in, in, out) is det.
+
+:- func count(statkey, stat) = stat.
+:- mode count(in, in) = out is det.
+
+:- func count(int, statkey, stat) = stat.
+:- mode count(in, in, in) = out is det.
+
+:- func union(stat, stat) = stat.
+% Sums the information in two stat stores.
+
+:- func to_assoc_list(stat) = assoc_list(statkey, int).
+
+% :- import_module pprint.
+
+% :- func to_doc(stat::in) = (doc::out) is det.
+:- func plain_to_string(stat::in) = (string::out) is det.
+:- func to_string(stat::in) = (string::out) is det.
+:- func subs_to_string(stat::in) = (string::out) is det.
+
+
+%% Other useful predicates for evaluating something
+
+:- func minavgmax_string(list(int)::in) = (string::out) is det.
+
+:- implementation.
+
+:- import_module bag.
+:- import_module std_util.
+
+:- type stat == bag(list(string)).
+
+init = bag__init.
+blank = construct_bug_submodule__init.
+
+count(Elem, InStat, OutStat) :-
+ bag__insert(InStat, Elem, OutStat).
+count(Count, Elem, InStat, OutStat) :-
+ bag__insert_list(InStat, list__duplicate(Count, Elem), OutStat).
+
+count_more(Elem, Count, InStat, OutStat) :-
+ count(Count, Elem, InStat, OutStat).
+
+count(Elem, InStat) = OutStat :-
+ count(Elem, InStat, OutStat).
+
+count(Count, Elem, InStat) = OutStat :-
+ count(Count, Elem, InStat, OutStat).
+
+union(A, B) = bag__union(A, B).
+to_assoc_list(Stat) = bag__to_assoc_list(Stat).
+
+to_string(Stat) =
+ "% Base Counts:\n"
+ ++ plain_to_string(Stat)
+ ++ "% Subtotals:\n"
+ ++ plain_to_string(calc_subtotals(Stat)).
+subs_to_string(Stat) =
+ plain_to_string(calc_subtotals(Stat)).
+
+plain_to_string(Stat) = Out :-
+ Counts = bag__to_assoc_list(Stat),
+ list__sort(comparator(Stat,0), Counts, CountsS),
+ list__map(
+ (pred((Name-Count)::in, Line::out) is det :-
+ Line = string__int_to_string(Count)++"\t"++join_list("-", Name)
+ ), CountsS, Lines),
+ Out = join_list("\n", Lines)++"\n"
+ .
+
+:- pred comparator(stat, int, pair(statkey, int), pair(statkey, int), comparison_result).
+:- mode comparator(in, in, in, in, out) is det.
+
+comparator(Stats, Level, (ADescr-ANum), (BDescr-BNum), Out) :-
+ if take(Level, ADescr, ALevel)
+ then
+ (
+ if take(Level, BDescr, BLevel)
+ then
+ (
+ if count_value(Stats, ALevel) < count_value(Stats, BLevel)
+ then Out = (>)
+ else
+ if count_value(Stats, ALevel) > count_value(Stats, BLevel)
+ then Out = (<)
+ else
+ % same value
+ if ALevel = BLevel
+ then comparator(Stats, Level+1, (ADescr-ANum), (BDescr-BNum), Out)
+ else
+ if compare((<), ALevel, BLevel)
+ then Out = (>)
+ else Out = (<)
+ )
+ else
+ Out = (>)
+ )
+ else
+ if take(Level, BDescr, _BLevel)
+ then Out = (<)
+ else Out = (=).
+
+:- func calc_subtotals(stat::in) = (stat::out) is det.
+calc_subtotals(Stat) = OutStat :-
+ Counts = bag__to_assoc_list(Stat),
+ list__foldl(
+ (pred((Name - Count)::in, InBag::in, OutBag::out) is det :-
+ aggregate(substarts(Name), count(Count), InBag, OutBag)
+ ), Counts, Stat, OutStat).
+
+/*
+ ** buggy pprint, do not use.
+to_string(Stat) = Str :-
+ Str = pprint__to_string(150, construct_bug_submodule__to_doc(Stat)).
+
+to_doc(Stat) =
+ text("% Base Counts:\n")
+ `<>` plain_to_doc(Stat)
+ `</>`
+ text("% Subtotals:\n")
+ `<>` subtotals_to_doc(Stat).
+
+:- func plain_to_doc(stat::in) = (doc::out) is det.
+:- func subtotals_to_doc(stat::in) = (doc::out) is det.
+
+plain_to_doc(Stat) = Out :-
+ Counts = bag__to_assoc_list(Stat),
+ Out =
+ % text("% Statistiky") `</>`
+ separated(
+ (func((Name-Count)::in) = (Doc::out) is det :-
+ Doc = to_doc(Count) `<>` text("\t")
+ `<>` text(join("-", Name))
+ ), line, Counts)
+ `<>` line.
+
+subtotals_to_doc(Stat) = Out :-
+ Counts = bag__to_assoc_list(Stat),
+ list__foldl(
+ (pred((Name - Count)::in, InBag::in, OutBag::out) is det :-
+ aggregate(substarts(Name), count(Count), InBag, OutBag)
+ ), Counts, Stat, Subtotals),
+ Out = plain_to_doc(Subtotals).
+*/
+:- pred substarts(list(T)::in, list(T)::out) is multi.
+
+substarts([], []).
+substarts([_LastElem], []).
+substarts([Elem1, Elem2|Rest], Out) :-
+ Out = []
+ ;
+ substarts([Elem2|Rest], TOut),
+ Out = [Elem1|TOut].
+
+
+:- import_module float.
+
+minavgmax_string(List) = int_to_string(length(List))++":"++Min++"/"++Avg++"/"++Max :-
+ List = [],
+ Min = "-", Avg = "-", Max = "-"
+ ;
+ List = [H|Tail],
+ list__foldl3(
+ (pred(N::in, MinSoFar::in, NewMin::out, MaxSoFar::in, NewMax::out, SumSoFar::in, NewSum::out) is det:-
+ NewSum = SumSoFar + N,
+ NewMin = (if N < MinSoFar then N else MinSoFar),
+ NewMax = (if N > MaxSoFar then N else MaxSoFar)
+ ), Tail, H, MinN, H, MaxN, H, SumN),
+ Min = int_to_string(MinN),
+ Max = int_to_string(MaxN),
+ Prec = float(10),
+ Avg = float_to_string(float(round_to_int(
+ (float(SumN)/float(length(List)))*Prec
+ ))/Prec)
+ .
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
The University of Melbourne | of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh> | -- the last words of T. S. Garp.
--------------------------------------------------------------------------
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