[m-rev.] for review: make some io procedures return "" instead of NULL

[Ian MacLarty]

For review by anyone.

Estimated hours taken: 1
Branches: main and 0.12

Make some procedures in the io library return strings instead of NULL.  This
is a problem for the debugger since it segfaults when trying to display the
strings on screen.  mdb should probably be made to handle invalid string
pointers better, but that requires a bigger change.

library/io.m:
	Make ML_maybe_make_err_msg, ML_maybe_make_win32_err_msg and
	read_line_as_string_2 return an empty string instead of NULL.

tests/debugger/declarative/Mmakefile:
tests/debugger/declarative/sort.exp:
tests/debugger/declarative/sort.inp:
tests/debugger/declarative/sort.input:
tests/debugger/declarative/sort.m:
	Add a regression test.  This test segfaulted previously.

Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.329
diff -u -r1.329 io.m
--- library/io.m	18 May 2005 05:25:58 -0000	1.329
+++ library/io.m	18 May 2005 07:38:05 -0000
@@ -1928,7 +1928,7 @@
 		memcpy(RetString, read_buffer, i * sizeof(MR_Char));
 		RetString[i] = '\\0';
 	} else {
-		RetString = NULL;
+		RetString = MR_make_string_const("""");
 	}
 	if (read_buffer != initial_read_buffer) {
 		MR_free(read_buffer);
@@ -8360,7 +8360,7 @@
 /*
 ** ML_maybe_make_err_msg(was_error, errno, msg, procname, error_msg):
 **	if `was_error' is true, then append `msg' and `strerror(errno)'
-**	to give `error_msg'; otherwise, set `error_msg' to NULL.
+**	to give `error_msg'; otherwise, set `error_msg' to "".
 **
 ** WARNING: this must only be called when the `hp' register is valid.
 ** That means it must only be called from procedures declared
@@ -8390,7 +8390,7 @@
 			strcpy((error_msg), msg);			\\
 			strcat((error_msg), errno_msg);			\\
 		} else {						\\
-			(error_msg) = NULL;				\\
+			(error_msg) = MR_make_string_const("""");		\\
 		}							\\
 	} while(0)

@@ -8398,7 +8398,7 @@
 ** ML_maybe_make_win32_err_msg(was_error, error, msg, procname, error_msg):
 **	if `was_error' is true, then append `msg' and the string
 **	returned by the Win32 API function FormatMessage() for the
-**	last error to give `error_msg'; otherwise, set `error_msg' to NULL.
+**	last error to give `error_msg'; otherwise, set `error_msg' to "".
 **	Aborts if MR_WIN32 is not defined.
 **
 ** WARNING: this must only be called when the `hp' register is valid.
@@ -8450,7 +8450,7 @@
 				LocalFree(err_buf);			\\
 			}						\\
 		} else {						\\
-			(error_msg) = NULL;				\\
+			(error_msg) = MR_make_string_const("""");	\\
 		}							\\
 	} while(0)

@@ -8701,7 +8701,7 @@
 		Status = 1;
 	}
 #else /* !MR_HAVE_READLINK */
-	TargetFileName = NULL;
+	TargetFileName = MR_make_string_const("""");
 	Status = 0;
 #endif
 	MR_update_io(IO0, IO);
Index: tests/debugger/declarative/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/Mmakefile,v
retrieving revision 1.75
diff -u -r1.75 Mmakefile
--- tests/debugger/declarative/Mmakefile	13 Apr 2005 09:32:17 -0000	1.75
+++ tests/debugger/declarative/Mmakefile	19 May 2005 01:19:28 -0000
@@ -75,7 +75,8 @@
 # decldebug grade.
 #
 DECLDEBUG_DECLARATIVE_PROGS=	\
-	builtin_call_rep
+	builtin_call_rep	\
+	sort

 # The following should not be run in decldebug grades.
 #
@@ -418,6 +419,11 @@
 	$(MDB) ./solutions < solutions.$(DECLDEBUG_INP) 2>&1 | \
 		sed -e 's/std_util.m:[0-9]*/std_util.m:NNNN/g' \
 		> solutions.out 2>&1 \
+	|| { grep . $@ /dev/null; exit 1; }
+
+sort.out: sort sort.inp
+	$(MDB_STD) ./sort sort.input < sort.inp \
+		> sort.out 2>&1 \
 	|| { grep . $@ /dev/null; exit 1; }

 special_term_dep.out: special_term_dep special_term_dep.inp
Index: tests/debugger/declarative/sort.exp
===================================================================
RCS file: tests/debugger/declarative/sort.exp
diff -N tests/debugger/declarative/sort.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/sort.exp	19 May 2005 04:35:21 -0000
@@ -0,0 +1,55 @@
+      E1:     C1 CALL pred sort.main/2-0 (det) sort.m:27
+mdb> echo on
+Command echo enabled.
+mdb> register --quiet
+mdb> table_io start
+I/O tabling started.
+mdb> finish
+ian
+ian
+ian
+ian
+      E2:     C1 EXIT pred sort.main/2-0 (det) sort.m:27
+mdb> set format pretty
+mdb> set depth 1
+mdb> dd
+main(...)
+16 tabled IO actions:
+command_line_arguments(...)
+do_open_text(...)
+get_stream_db(...)
+set_stream_db(...)
+read_line_as_string_2(...)
+read_line_as_string_2(...)
+read_line_as_string_2(...)
+read_line_as_string_2(...)
+read_line_as_string_2(...)
+write_string(...)
+write_string(...)
+write_string(...)
+write_string(...)
+write_string(...)
+write_string(...)
+write_string(...)
+Valid? set depth 10
+dd> print io 9
+read_line_as_string_2(<<foreign>>, yes, -1, "")
+dd> set depth 1
+dd> no
+open_stream(...)
+3 tabled IO actions:
+do_open_text(...)
+get_stream_db(...)
+set_stream_db(...)
+Valid? yes
+read_lines(...)
+5 tabled IO actions:
+read_line_as_string_2(...)
+read_line_as_string_2(...)
+read_line_as_string_2(...)
+read_line_as_string_2(...)
+read_line_as_string_2(...)
+Valid? quit
+Diagnosis aborted.
+      E2:     C1 EXIT pred sort.main/2-0 (det) sort.m:27
+mdb> quit -y
Index: tests/debugger/declarative/sort.inp
===================================================================
RCS file: tests/debugger/declarative/sort.inp
diff -N tests/debugger/declarative/sort.inp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/sort.inp	19 May 2005 04:34:58 -0000
@@ -0,0 +1,14 @@
+echo on
+register --quiet
+table_io start
+finish
+set format pretty
+set depth 1
+dd
+set depth 10
+print io 9
+set depth 1
+no
+yes
+quit
+quit -y
Index: tests/debugger/declarative/sort.input
===================================================================
RCS file: tests/debugger/declarative/sort.input
diff -N tests/debugger/declarative/sort.input
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/sort.input	19 May 2005 01:15:55 -0000
@@ -0,0 +1,4 @@
+ian
+zoltan
+rafe
+julien
Index: tests/debugger/declarative/sort.m
===================================================================
RCS file: tests/debugger/declarative/sort.m
diff -N tests/debugger/declarative/sort.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/sort.m	19 May 2005 01:15:21 -0000
@@ -0,0 +1,149 @@
+%----------------------------------------------------------------------------%
+
+:- module sort.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module exception.
+:- import_module int.
+:- import_module list.
+:- import_module std_util.
+:- import_module string.
+
+%----------------------------------------------------------------------------%
+
+:- type line  == string.
+:- type lines == list(string).
+
+main(!IO) :-
+	io.command_line_arguments(Args, !IO),
+	open_stream(Args, MaybeStream, !IO),
+	(
+		MaybeStream = ok(InputStream),
+		some [!Words] (
+			read_lines(InputStream, !:Words, !IO),
+ 			sort_lines(!Words),
+			print_lines(!.Words, !IO)
+		)
+	;
+		MaybeStream = error(ErrorMessage),
+		io.stderr_stream(StdErr, !IO),
+		io.format(StdErr, "%s\n", [s(ErrorMessage)], !IO),
+		io.set_exit_status(1, !IO)
+	).
+
+%----------------------------------------------------------------------------%
+
+:- pred open_stream(list(string)::in, maybe_error(io.input_stream)::out,
+	io::di, io::uo) is det.
+
+open_stream([], MaybeStream, !IO) :-
+	io.stdin_stream(Stdin, !IO),
+	MaybeStream = ok(Stdin).
+open_stream([Arg], MaybeStream, !IO) :-
+	io.open_input(Arg, MaybeStream0, !IO),
+	(
+		MaybeStream0 = ok(Stream),
+		MaybeStream  = ok(Stream)
+	;
+		MaybeStream0 = error(Error),
+		io.error_message(Error, ErrorMessage),
+		MaybeStream  = error(ErrorMessage)
+	).
+open_stream([_,_|_], error(ErrorMessage), !IO) :-
+	ErrorMessage = "usage: sort [Input]".
+
+%----------------------------------------------------------------------------%
+
+:- pred read_lines(io.input_stream::in, lines::out, io::di, io::uo) is det.
+
+read_lines(Stream, Lines, !IO) :-
+	read_lines_2(Stream, [], Lines, !IO).
+
+:- pred read_lines_2(io.input_stream::in, lines::in,
+	lines::out, io::di, io::uo) is det.
+
+read_lines_2(Stream, !Lines, !IO) :-
+	io.read_line_as_string(Stream, Result, !IO),
+	(
+		Result = ok(Line),
+		list.cons(Line, !Lines),
+		read_lines_2(Stream, !Lines, !IO)
+	;
+		Result = eof
+	;
+		Result = error(Error),
+		io.error_message(Error, ErrorMessage),
+		throw(ErrorMessage)
+	).
+
+%----------------------------------------------------------------------------%
+
+:- pred sort_lines(lines::in, lines::out) is det.
+
+sort_lines(Us, Ss) :-
+	N = list.length(Us),
+	msort_n(N, Us, Ss, _).
+
+:- pred msort_n(int::in, lines::in, lines::out, lines::out) is det.
+
+msort_n(N, Unsorted, SortedPart, Rest) :-
+	(
+		N =< 0
+	->
+		SortedPart = [],
+		Rest = Unsorted
+	;
+		N = 1
+	->
+		(
+			Unsorted = [U | Us],
+			SortedPart = [U],
+			Rest = Us
+		;
+			Unsorted = [],
+			throw("Unsorted = [] and N = 0")
+		)
+	;
+		N1 = N // 2,
+		sort.msort_n(N1, Unsorted, Ss1, Us2),
+		N2 = N - N1,
+		msort_n(N2, Us2, Ss2, Rest),
+		sort.merge(Ss1, Ss2, SortedPart)
+	).
+
+:- pred merge(lines::in, lines::in, lines::out) is det.
+
+merge([], [], []).
+merge([S | Ss], [], [S | Ss]).
+merge([], [S | Ss], [S | Ss]).
+merge([A | As], [B | Bs], [C | Cs]) :-
+	compare(Cmp, A, B),
+	(
+		( Cmp = (<) ; Cmp = (=) )
+	->
+		sort.merge(As, [B | Bs], Cs),
+		C = A
+	;
+		sort.merge(As, [B | Bs], Cs), % BUG
+		C = B
+	).
+
+%----------------------------------------------------------------------------%
+
+:- pred print_lines(lines::in, io::di, io::uo) is det.
+
+print_lines(Lines, !IO) :- io.write_list(Lines, "", io.write_string, !IO).
+
+%----------------------------------------------------------------------------%
+:- end_module sort.
+%----------------------------------------------------------------------------%

--------------------------------------------------------------------------
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
--------------------------------------------------------------------------