[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