[Gd-chatter] r11020 - in trunk: libraries/parse-arguments libraries/parse-arguments/tests libraries/registry/generic src/common/getopt src/tests
cgay at gwydiondylan.org
cgay at gwydiondylan.org
Sun Dec 3 18:36:32 CET 2006
Author: cgay
Date: Sun Dec 3 18:36:28 2006
New Revision: 11020
Added:
trunk/libraries/parse-arguments/tests/
trunk/libraries/parse-arguments/tests/getopt-test-suite-app-library.dylan (contents, props changed)
trunk/libraries/parse-arguments/tests/getopt-test-suite-app.dylan (contents, props changed)
trunk/libraries/parse-arguments/tests/getopt-test-suite-app.lid (contents, props changed)
trunk/libraries/parse-arguments/tests/getopt-test-suite-library.dylan (contents, props changed)
trunk/libraries/parse-arguments/tests/getopt-test-suite.dylan (contents, props changed)
trunk/libraries/parse-arguments/tests/getopt-test-suite.lid (contents, props changed)
trunk/libraries/registry/generic/getopt (contents, props changed)
trunk/libraries/registry/generic/getopt-test-suite (contents, props changed)
trunk/libraries/registry/generic/getopt-test-suite-app (contents, props changed)
Removed:
trunk/src/common/getopt/
trunk/src/tests/getopt-test-exports.dylan
trunk/src/tests/getopt-test.dylan
trunk/src/tests/getopt-test.lid
Modified:
trunk/libraries/parse-arguments/defargparser.dylan
trunk/libraries/parse-arguments/getopt-exports.dylan
trunk/libraries/parse-arguments/getopt.dylan
trunk/libraries/parse-arguments/getopt.lid
trunk/libraries/parse-arguments/parsers.dylan
trunk/src/tests/Makegen
Log:
job: 7335
First part of unifying the getopt library.
* Merged the minor differences in the main getopt code into libraries/parse-arguments.
* Moved test code from src/tests/getopt* to libraries/parse-arguments/tests.
Modified: trunk/libraries/parse-arguments/defargparser.dylan
==============================================================================
--- trunk/libraries/parse-arguments/defargparser.dylan (original)
+++ trunk/libraries/parse-arguments/defargparser.dylan Sun Dec 3 18:36:28 2006
@@ -149,8 +149,8 @@
// synopsis print-synopsis,
// usage: "test [options] file...",
// description: "Stupid test program doing nothing with the args.";
-//
-// ...
+// option verbose?, "", "Explanation", short: "v", long: "verbose";
+// option other, "", "foo", long: "other-option";
// end argument-parser;
//
// Then print-synopsis(parser, stream) will print something like:
Modified: trunk/libraries/parse-arguments/getopt-exports.dylan
==============================================================================
--- trunk/libraries/parse-arguments/getopt-exports.dylan (original)
+++ trunk/libraries/parse-arguments/getopt-exports.dylan Sun Dec 3 18:36:28 2006
@@ -27,7 +27,6 @@
define library parse-arguments
use common-dylan;
-// use table-extensions;
use io;
export
@@ -69,9 +68,7 @@
// Used by most programs.
define module parse-arguments
- use common-dylan;
-// use extensions;
-// use table-extensions;
+ use common-dylan, exclude: { format-to-string };
use option-parser-protocol;
export
Modified: trunk/libraries/parse-arguments/getopt.dylan
==============================================================================
--- trunk/libraries/parse-arguments/getopt.dylan (original)
+++ trunk/libraries/parse-arguments/getopt.dylan Sun Dec 3 18:36:28 2006
@@ -53,6 +53,20 @@
// are options, and "bar" is a parameter. "baz" is a regular argument.
+// todo -- There is no error signalled if two options have the same short name
+// (or long name, I assume). In fact there's a comment saying that the
+// rightmost argument with the same name takes precedence. So this is
+// by design???
+//
+// todo -- There is no indication of default values in the generated synopsis,
+// and the syntax for specifying "syntax" and docstring is bizarre at
+// best. --cgay 2006.11.27
+//
+// todo -- defargparser-synopsis generates code that calls "format" and if the
+// calling module doesn't import format it gets warnings. It probably
+// doesn't need to be a macro.
+
+
//======================================================================
// <argument-list-parser>
//======================================================================
@@ -61,15 +75,15 @@
// Retained across calls to parse-arguments.
slot option-parsers :: <stretchy-vector> /* of <option-parser> */ =
make(<stretchy-vector> /* of <option-parser> */);
- slot option-short-name-map :: <string-table> /* of <option-parser> */ =
+ constant slot option-short-name-map :: <string-table> /* of <option-parser> */ =
make(<string-table>);
- slot option-long-name-map :: <string-table> /* of <option-parser> */ =
+ constant slot option-long-name-map :: <string-table> /* of <option-parser> */ =
make(<string-table>);
- slot parameter-options :: <string-table> /* of <boolean> */ =
+ constant slot parameter-options :: <string-table> /* of <boolean> */ =
make(<string-table>);
// Information generated by parsing arguments.
- slot tokens :: <deque> /* of: <argument-token> */ =
+ constant slot tokens :: <deque> /* of: <argument-token> */ =
make(<deque> /* of: <argument-token> */);
slot regular-arguments :: <stretchy-vector> /* of: <string> */ =
make(<stretchy-vector> /* of: <string> */);
@@ -194,7 +208,7 @@
//======================================================================
define abstract class <argument-token> (<object>)
- slot token-value :: <string>,
+ constant slot token-value :: <string>,
required-init-keyword: value:;
end class <argument-token>;
@@ -205,7 +219,7 @@
end class <option-token>;
define class <short-option-token> (<option-token>)
- slot tightly-bound-to-next-token?,
+ constant slot tightly-bound-to-next-token?,
init-keyword: tightly-bound?:,
init-value: #f;
end class <short-option-token>;
@@ -295,6 +309,7 @@
pop(args);
else
usage-error();
+ "" // stifle warning
end;
end method,
Modified: trunk/libraries/parse-arguments/getopt.lid
==============================================================================
--- trunk/libraries/parse-arguments/getopt.lid (original)
+++ trunk/libraries/parse-arguments/getopt.lid Sun Dec 3 18:36:28 2006
@@ -1,5 +1,5 @@
library: parse-arguments
-files: getopt-exports.dylan
- getopt.dylan
- parsers.dylan
- defargparser.dylan
+files: getopt-exports
+ getopt
+ parsers
+ defargparser
Modified: trunk/libraries/parse-arguments/parsers.dylan
==============================================================================
--- trunk/libraries/parse-arguments/parsers.dylan (original)
+++ trunk/libraries/parse-arguments/parsers.dylan Sun Dec 3 18:36:28 2006
@@ -33,10 +33,10 @@
// absract class takes care of the details.
define abstract open primary class <negative-option-parser> (<option-parser>)
- slot negative-long-options :: <list> /* of: <string> */,
+ constant slot negative-long-options :: <list> /* of: <string> */,
init-keyword: negative-long-options:,
init-value: #();
- slot negative-short-options :: <list> /* of: <string> */,
+ constant slot negative-short-options :: <list> /* of: <string> */,
init-keyword: negative-short-options:,
init-value: #();
end class <negative-option-parser>;
Added: trunk/libraries/parse-arguments/tests/getopt-test-suite-app-library.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/parse-arguments/tests/getopt-test-suite-app-library.dylan Sun Dec 3 18:36:28 2006
@@ -0,0 +1,11 @@
+module: dylan-user
+
+define library getopt-test-suite-app
+ use testworks;
+ use getopt-test-suite;
+end library;
+
+define module getopt-test-suite-app
+ use testworks;
+ use getopt-test-suite;
+end module;
Added: trunk/libraries/parse-arguments/tests/getopt-test-suite-app.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/parse-arguments/tests/getopt-test-suite-app.dylan Sun Dec 3 18:36:28 2006
@@ -0,0 +1,3 @@
+module: getopt-test-suite-app
+
+run-test-application(getopt-test-suite);
Added: trunk/libraries/parse-arguments/tests/getopt-test-suite-app.lid
==============================================================================
--- (empty file)
+++ trunk/libraries/parse-arguments/tests/getopt-test-suite-app.lid Sun Dec 3 18:36:28 2006
@@ -0,0 +1,4 @@
+library: getopt-test-suite-app
+executable: getopt-test-suite-app
+files: getopt-test-suite-app-library
+ getopt-test-suite-app
Added: trunk/libraries/parse-arguments/tests/getopt-test-suite-library.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/parse-arguments/tests/getopt-test-suite-library.dylan Sun Dec 3 18:36:28 2006
@@ -0,0 +1,19 @@
+module: dylan-user
+
+define library getopt-test-suite
+ use common-dylan;
+ use io;
+ use parse-arguments;
+ use testworks;
+
+ export getopt-test-suite;
+end library;
+
+define module getopt-test-suite
+ use common-dylan, exclude: { format-to-string };
+ use format;
+ use parse-arguments;
+ use testworks;
+
+ export getopt-test-suite;
+end module;
Added: trunk/libraries/parse-arguments/tests/getopt-test-suite.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/parse-arguments/tests/getopt-test-suite.dylan Sun Dec 3 18:36:28 2006
@@ -0,0 +1,142 @@
+module: getopt-test-suite
+synopsis: Test suite for the getopt (command-line parser) library.
+
+//======================================================================
+//
+// Copyright (c) 1998 Eric Kidd
+// All rights reserved.
+//
+// Use and copying of this software and preparation of derivative
+// works based on this software are permitted, including commercial
+// use, provided that the following conditions are observed:
+//
+// 1. This copyright notice must be retained in full on any copies
+// and on appropriate parts of any derivative works. (Other names
+// and years may be added, so long as no existing ones are removed.)
+//
+// This software is made available "as is". Neither the authors nor
+// Carnegie Mellon University make any warranty about the software,
+// its performance, or its conformity to any specification.
+//
+// Bug reports, questions, comments, and suggestions should be sent by
+// E-mail to the Internet address "gd-bugs at gwydiondylan.org".
+//
+//======================================================================
+
+// Modified by Carl Gay to use the testworks library and to test
+// defargparser. Moved from src/tests to libraries/getopt/tests.
+// 2006.11.29
+
+
+define suite getopt-test-suite
+ (/* setup-function: foo, cleanup-function: bar */)
+ test argument-list-parser-test;
+ test defargparser-test;
+end suite;
+
+
+// Create a parser for our standard test argument list, parse the given
+// argument list, return the parser.
+define function parse (#rest argv)
+ let parser = make(<argument-list-parser>);
+ // Usage: progname [-qvfB] [-Q arg] [-O [arg]] [-W arg]* [-Dkey[=value]]*
+ add-option-parser-by-type(parser,
+ <simple-option-parser>,
+ long-options: #("verbose"),
+ short-options: #("v"),
+ negative-long-options: #("quiet"),
+ negative-short-options: #("q"),
+ default: #t);
+ add-option-parser-by-type(parser,
+ <simple-option-parser>,
+ long-options: #("foo"),
+ short-options: #("f"),
+ negative-long-options: #("no-foo"),
+ negative-short-options: #("B"),
+ default: #f);
+ add-option-parser-by-type(parser,
+ <parameter-option-parser>,
+ long-options: #("quux"),
+ short-options: #("Q"));
+ add-option-parser-by-type(parser,
+ <optional-parameter-option-parser>,
+ long-options: #("optimize"),
+ short-options: #("O"));
+ add-option-parser-by-type(parser,
+ <repeated-parameter-option-parser>,
+ long-options: #("warning"),
+ short-options: #("W"));
+ add-option-parser-by-type(parser,
+ <keyed-option-parser>,
+ long-options: #("define"),
+ short-options: #("D"));
+ values(parser, parse-arguments(parser, argv))
+end function parse;
+
+define test argument-list-parser-test ()
+ let (parser, parse-result) = parse("--frobozz");
+ check-equal("parse-arguments returns #f for an unparsable command line",
+ parse-result,
+ #f);
+
+ let (parser, parse-result) = parse("--quiet");
+ check-equal("parse-arguments returns #t for a parsable command line",
+ parse-result,
+ #t);
+
+ // A correct parse with all arguments specified in long format.
+ let (parser, parse-result) = parse("--verbose", "--foo",
+ "--quux", "quux-value",
+ "--optimize=optimize-value",
+ "--warning", "warning-value",
+ "--define", "key", "=", "value");
+ check-equal("verbose is true",
+ option-value-by-long-name(parser, "verbose"),
+ #t);
+ check-equal("foo has correct value",
+ option-value-by-long-name(parser, "foo"),
+ #t);
+ check-equal("quux has correct value",
+ option-value-by-long-name(parser, "quux"),
+ "quux-value");
+ check-equal("optimize has correct value",
+ option-value-by-long-name(parser, "optimize"),
+ "optimize-value");
+ check-equal("warning has correct value",
+ option-value-by-long-name(parser, "warning"),
+ #("warning-value"));
+ let defines = option-value-by-long-name(parser, "define");
+ check-equal("key is defined as 'value'", defines["key"], "value");
+ check-true("regular arguments are empty", empty?(parser.regular-arguments));
+
+end test argument-list-parser-test;
+
+
+define argument-parser <defargparser-test-parser> ()
+ synopsis print-defargparser-test-synopsis,
+ usage: "test [options] file...",
+ description: "Stupid test program doing nothing with the args.";
+ option verbose?,
+ "", "Explanation",
+ short: "v",
+ long: "verbose";
+ option other,
+ "", "foo",
+ long: "other-option";
+ option log-filename,
+ "", "Log file pathname",
+ kind: <parameter-option-parser>,
+ long: "log",
+ short: "l";
+ regular-arguments file-names;
+end argument-parser;
+
+
+define test defargparser-test ()
+ let parser = make(<defargparser-test-parser>);
+ parse-arguments(parser, #());
+ check-false("Verbose flag is false if not supplied.",
+ parser.verbose?);
+ check-true("Regular arguments are empty.",
+ empty?(parser.file-names));
+end test defargparser-test;
Added: trunk/libraries/parse-arguments/tests/getopt-test-suite.lid
==============================================================================
--- (empty file)
+++ trunk/libraries/parse-arguments/tests/getopt-test-suite.lid Sun Dec 3 18:36:28 2006
@@ -0,0 +1,3 @@
+library: getopt-test-suite
+files: getopt-test-suite-library
+ getopt-test-suite
Added: trunk/libraries/registry/generic/getopt
==============================================================================
--- (empty file)
+++ trunk/libraries/registry/generic/getopt Sun Dec 3 18:36:28 2006
@@ -0,0 +1 @@
+abstract://dylan/parse-arguments/getopt.lid
Added: trunk/libraries/registry/generic/getopt-test-suite
==============================================================================
--- (empty file)
+++ trunk/libraries/registry/generic/getopt-test-suite Sun Dec 3 18:36:28 2006
@@ -0,0 +1 @@
+abstract://dylan/parse-arguments/tests/getopt-test-suite.lid
\ No newline at end of file
Added: trunk/libraries/registry/generic/getopt-test-suite-app
==============================================================================
--- (empty file)
+++ trunk/libraries/registry/generic/getopt-test-suite-app Sun Dec 3 18:36:28 2006
@@ -0,0 +1 @@
+abstract://dylan/parse-arguments/tests/getopt-test-suite-app.lid
\ No newline at end of file
Modified: trunk/src/tests/Makegen
==============================================================================
--- trunk/src/tests/Makegen (original)
+++ trunk/src/tests/Makegen Sun Dec 3 18:36:28 2006
@@ -5,7 +5,6 @@
= $d2c_runtime
. ' -L../common/collection-extensions'
. ' -L../common/common-dylan'
- . ' -L../common/getopt'
. ' -L../common/io'
. ' -L../common/matrix'
. ' -L../common/regular-expressions'
@@ -51,9 +50,6 @@
do emit_library_rule(
'format-out-test', '$(BUILDROOT)/force.timestamp ' . $deps, '', 'compile'
);
-do emit_library_rule(
- 'getopt-test', '$(BUILDROOT)/force.timestamp ' . $deps, '', 'compile'
-);
unless (1 || $features{'no_time'}) {
do emit_library_rule(
@@ -63,7 +59,7 @@
print <<"EOF"
-DYLANPATH=../d2c/runtime/transcendental:../common/collection-extensions:../common/table-ext:../common/string-ext:../common/standard-io:../common/streams:../common/print:../common/format:../common/matrix:../common/format-out:../common/time:../common/regular-expressions:../common/getopt
+DYLANPATH=../d2c/runtime/transcendental:../common/collection-extensions:../common/table-ext:../common/string-ext:../common/standard-io:../common/streams:../common/print:../common/format:../common/matrix:../common/format-out:../common/time:../common/regular-expressions
EOF
;
More information about the chatter
mailing list