[m-rev.] diff: fix debugger stream test failure

[Simon Taylor]

Estimated hours taken: 0.5
Branches: main

Fix failure of tests/debugger/declarative/io_stream_test.

library/stream.string_writer.m:
library/io.m:
	Move code to check whether an arbitrary type is an io.stream back
	into io.m.  Handle unwrapped streams.

Index: library/stream.string_writer.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/stream.string_writer.m,v
retrieving revision 1.1
diff -u -u -r1.1 stream.string_writer.m
--- library/stream.string_writer.m	21 Dec 2006 11:11:32 -0000	1.1
+++ library/stream.string_writer.m	4 Jan 2007 04:08:20 -0000
@@ -331,6 +331,10 @@
 :- pragma type_spec(do_write_univ_prio/6,
             (Stream = io.output_stream, State = io.state)).
 
+    % We only use the io.stream_db we read impurely when we have
+    % the io.state.
+:- pragma promise_pure(do_write_univ_prio/6).
+
 do_write_univ_prio(Stream, NonCanon, Univ, Priority, !State) :-
     % We need to special-case the builtin types:
     %   int, char, float, string
@@ -351,18 +355,13 @@
         write_type_ctor_desc(Stream, TypeCtorDesc, !State)
     ; univ_to_type(Univ, C_Pointer) ->
         write_c_pointer(Stream, C_Pointer, !State)
-    ; univ_to_type(Univ, IOStream) ->
-        write_io_stream(Stream, NonCanon, io.input_stream_info,
-                IOStream, Priority, !State)
-    ; univ_to_type(Univ, IOStream) ->
-        write_io_stream(Stream, NonCanon, io.output_stream_info,
-                IOStream, Priority, !State)
-    ; univ_to_type(Univ, IOStream) ->
-        write_io_stream(Stream, NonCanon, io.binary_input_stream_info,
-                IOStream, Priority, !State)
-    ; univ_to_type(Univ, IOStream) ->
-        write_io_stream(Stream, NonCanon, io.binary_output_stream_info,
-                IOStream, Priority, !State)
+    ;
+        impure io.get_stream_db(StreamDB),
+        StreamInfo = get_io_stream_info(StreamDB, univ_value(Univ))
+    ->
+        type_to_univ(StreamInfo, StreamInfoUniv),
+        do_write_univ_prio(Stream, NonCanon, StreamInfoUniv, Priority,
+            !.State, !:State)
     ;
         % Check if the type is array.array/1. We can't just use univ_to_type
         % here since array.array/1 is a polymorphic type.
@@ -406,31 +405,6 @@
         write_ordinary_term(Stream, NonCanon, Univ, Priority, !State)
     ).
 
-:- pred write_io_stream(Stream, deconstruct.noncanon_handling,
-    (func(io.stream_db, T) = io.maybe_stream_info), T, ops.priority,
-    State, State)
-    <= (stream.writer(Stream, string, State),
-    stream.writer(Stream, char, State)).
-:- mode write_io_stream(in, in(do_not_allow), (func(in, in) = out is det),
-    in, in, di, uo) is det.
-:- mode write_io_stream(in, in(canonicalize), (func(in, in) = out is det),
-    in, in, di, uo) is det.
-:- mode write_io_stream(in, in(include_details_cc),
-    (func(in, in) = out is det), in, in, di, uo) is cc_multi.
-:- mode write_io_stream(in, in, (func(in, in) = out is det),
-    in, in, di, uo) is cc_multi.
-
-write_io_stream(Stream, NonCanon, GetStreamInfo, IOStream, Priority, !State) :-
-    ( dynamic_cast(!.State, IOState) ->
-        io.get_stream_db(StreamDb, unsafe_promise_unique(IOState), _),
-        StreamInfo = GetStreamInfo(StreamDb, IOStream)
-    ;
-        StreamInfo = unknown_stream
-    ),
-    type_to_univ(StreamInfo, StreamInfoUniv),
-    do_write_univ_prio(Stream, NonCanon, StreamInfoUniv, Priority,
-        unsafe_promise_unique(!.State), !:State).
-
 :- pred same_array_elem_type(array(T)::unused, T::unused) is det.
 
 same_array_elem_type(_, _).
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.365
diff -u -u -r1.365 io.m
--- library/io.m	21 Dec 2006 11:11:31 -0000	1.365
+++ library/io.m	3 Jan 2007 02:22:08 -0000
@@ -1527,6 +1527,7 @@
     % about those streams.
     %
 :- pred io.get_stream_db(io.stream_db::out, io::di, io::uo) is det.
+:- impure pred io.get_stream_db(io.stream_db::out) is det.
 
     % Returns the information associated with the specified input
     % stream in the given stream database.
@@ -1552,6 +1553,10 @@
 :- func io.binary_output_stream_info(io.stream_db, io.binary_output_stream)
     = io.maybe_stream_info.
 
+    % If the univ contains an I/O stream, return information about that
+    % stream, otherwise fail.
+:- func get_io_stream_info(io.stream_db, T) = maybe_stream_info is semidet.
+
 %
 % For use by compiler/process_util.m:
 %
@@ -4170,6 +4175,22 @@
         Info  = unknown_stream
     ).
 
+get_io_stream_info(StreamDB, Stream) = StreamInfo :-
+    ( dynamic_cast(Stream, input_stream(IOStream0)) ->
+        IOStream = IOStream0
+    ; dynamic_cast(Stream, output_stream(IOStream0)) ->
+        IOStream = IOStream0
+    ; dynamic_cast(Stream, binary_input_stream(IOStream0)) ->
+        IOStream = IOStream0
+    ; dynamic_cast(Stream, binary_output_stream(IOStream0)) ->
+        IOStream = IOStream0
+    ; dynamic_cast(Stream, IOStream0) ->
+        IOStream = IOStream0
+    ;
+        fail
+    ),
+    StreamInfo = io.maybe_stream_info(StreamDB, IOStream).
+
 :- func maybe_source_name(maybe(stream_info)) = string.
 
 maybe_source_name(MaybeInfo) = Name :-
@@ -4190,6 +4211,13 @@
 source_name(stderr) = "<standard error>".
 
 :- pragma foreign_proc("C",
+    io.get_stream_db(StreamDb::out),
+    [will_not_call_mercury, tabled_for_io],
+"
+    StreamDb = ML_io_stream_db;
+").
+
+:- pragma foreign_proc("C",
     io.get_stream_db(StreamDb::out, IO0::di, IO::uo),
     [will_not_call_mercury, promise_pure, tabled_for_io],
 "
@@ -4208,6 +4236,13 @@
 ").
 
 :- pragma foreign_proc("C#",
+    io.get_stream_db(StreamDb::out),
+    [will_not_call_mercury, tabled_for_io],
+"
+    StreamDb = ML_io_stream_db;
+").
+
+:- pragma foreign_proc("C#",
     io.get_stream_db(StreamDb::out, _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, tabled_for_io],
 "
@@ -4222,6 +4257,13 @@
 ").
 
 :- pragma foreign_proc("Java",
+    io.get_stream_db(StreamDb::out),
+    [will_not_call_mercury, tabled_for_io],
+"
+    StreamDb = ML_io_stream_db;
+").
+
+:- pragma foreign_proc("Java",
     io.get_stream_db(StreamDb::out, _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, tabled_for_io],
 "
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------