diff: bug fix for getopt.m

[Tyson Richard DOWD]

Hi.

Speak now or I'll commit this...

===================================================================

Estimated hours taken: 0.5

Bug fix for getopt (from Philip Dart).

library/getopt.m:
	Handle "-" correctly - it was silently ignoring it. It should be
	treated as if it is a normal argument, not an option.

tests/hard_coded/Mmake:
tests/hard_coded/getopt_test.m:
tests/hard_coded/getopt_test.exp:
	Test case for this bug.

Index: library/getopt.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/getopt.m,v
retrieving revision 1.14
diff -u -r1.14 getopt.m
--- getopt.m	1997/06/19 07:13:23	1.14
+++ getopt.m	1997/07/08 02:40:59
@@ -229,7 +229,7 @@
 			Result = error(ErrorMsg),
 			Args = Args0
 		)
-	; string__first_char(Option, '-', ShortOptions) ->
+	; string__first_char(Option, '-', ShortOptions), ShortOptions \= "" ->
 		string__to_char_list(ShortOptions, ShortOptionsList),
 		% Process a single negated option `-x-'.
 		( ShortOptionsList = [SingleShortOpt, '-'] ->
Index: tests/hard_coded/Mmake
===================================================================
RCS file: /home/staff/zs/imp/tests/hard_coded/Mmake,v
retrieving revision 1.47
diff -u -r1.47 Mmake
--- Mmake	1997/06/27 04:04:44	1.47
+++ Mmake	1997/07/08 05:32:30
@@ -26,6 +26,7 @@
 	free_free_mode \
 	func_and_pred \
 	func_test \
+	getopt_test \
 	higher_order_func_test \
 	higher_order_syntax \
 	ho_func_reg \

New File: tests/hard_coded/getopt_test.m
===================================================================
%
% Regression test.
%
% Name: getopt_test.m
%
% Description of bug:
%	"-" was not being handled correctly by getopt. It should be left
%	alone, but was being processed by an option.
%
% Symptom(s) of bug:
% 	"-" as an option would be silently ignored.
%
% Date bug existed: 8-July-1997
%
% Author: trd
%
% Note: This bug report (and fix) provided by Philip Dart.

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

:- module getopt_test.
:- interface.
:- import_module io, getopt.

:- type option	
	--->	foo
	;	bar.

:- type option_table	==	option_table(option).
		
:- pred short_option(character::in, option::out) is semidet.
:- pred long_option(string::in, option::out) is semidet.
:- pred option_defaults(option::out, option_data::out) is nondet.
:- pred option_default(option::out, option_data::out) is multidet.

:- pred main(io__state::di, io__state::uo) is det.

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

:- implementation.
:- import_module require, list, std_util, bool.

option_defaults(Option, Default) :-
	semidet_succeed,
	option_default(Option, Default).

option_default(foo,		string("happy")).
option_default(bar,		bool(yes)).

short_option('f',			foo).
short_option('b',			bar).

long_option("foo",			foo).
long_option("bar",			bar).

main -->
	{ getopt__process_options(option_ops(short_option, long_option, 
		option_defaults), ["-"], Left, MaybeOptionTable) },
	(
		{ MaybeOptionTable = ok(OptionTable) }
	->
		{ getopt__lookup_bool_option(OptionTable, bar,
			Bar) },
		{ getopt__lookup_string_option(OptionTable, foo,
			FooStr) },
		io__write_string("option bar: `"),
		io__write(Bar),
		io__write_string("'\n"),
		io__write_string("option foo: `"),
		io__write_string(FooStr),
		io__write_string("'\n"),

		io__write(Left),
		io__write_string("\n")
		
	;
		{ error("unable to process options") }
	).


-- 
       Tyson Dowd           # Assimilation doesn't kill people -- 
                            # resistance kills people.
     trd at cs.mu.oz.au        # 
http://www.cs.mu.oz.au/~trd # (Seen on back of Borg cube.)