Merge 16546,16556,16820 from dev version.

4 files changed, 81 insertions, 7 deletions

diff --git a/ChangeLog b/ChangeLog
index 443660a9c..e44aa9cdb 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2002-03-17  Bart Schaefer  <schaefer@zsh.org>
+
+	* 16820: Test/E01options.ztst: change tests to match 16759.
+
+	* 16556: Src/builtin.c: Error messages added in 16504,16505 should
+	not change the behavior of >&- redirections.
+
+	* Felix Rosencrantz: 16546: Completion/Unix/Command/_perl:
+	complete the arguments to a perl script with _normal.
+
 2002-03-17  Clint Adams  <clint@zsh.org>
 
         * 16850: Completion/Unix/Command/_rsync: remote file completion via
diff --git a/Completion/Unix/Command/_perl b/Completion/Unix/Command/_perl
new file mode 100644
index 000000000..29016e333
--- /dev/null
+++ b/Completion/Unix/Command/_perl
@@ -0,0 +1,63 @@
+#compdef perl
+#
+# zsh completion code for the Perl interpreter
+# Adam Spiers <adam@spiers.net>
+#
+
+_perl () {
+  _arguments -s \
+    '-0-:input record separator in octal (\0, if no argument): ' \
+    '-a[autosplit mode with -n or -p (splits $_ into @F)]' \
+    "-c[check syntax only (runs BEGIN and END blocks)]" \
+    '-d[run scripts under debugger]' \
+    '-d\:-[run under control of a debugging/tracing module]:debugging/tracing module:_perl_modules' \
+    '-D-:set debugging flags (argument is a bit mask or flags): ' \
+    "*-e+:one line of script. Several -e's allowed. Omit [programfile]." \
+    "-F-:split() pattern for autosplit (-a). The //'s are optional.: " \
+    '-h[list help summary]' \
+    '-i-[edit <> files in place (make backup if extension supplied)]:backup file extension: ' \
+    '*-I-[specify @INC/#include directory (may be used more than once)]:include path:_files -/' \
+    '-l-[enable line ending processing, specifies line terminator]:output record separator in octal: ' \
+    \*{-m,-M}"-[module.. executes \`use/no module...' before executing your script.]:module:_perl_m_opt" \
+    "-n[assume 'while (<>) { ... }' loop around your script]" \
+    "-p[assume loop like -n but print line also like sed]" \
+    "-P[run script through C preprocessor before compilation]" \
+    "-s[enable some switch parsing for switches after script name]" \
+    "-S[look for the script using PATH environment variable]" \
+    "-T[turn on tainted checks]" \
+    "-u[dump core after parsing script]" \
+    "-U[allow unsafe operations]" \
+    "-v[print version number, patchlevel plus VERY IMPORTANT perl info]" \
+    "-V-[print perl configuration information]:configuration keys:_perl_config_vars" \
+    '-w[TURN WARNINGS ON FOR COMPILATION OF YOUR SCRIPT. Recommended.]' \
+    '-x-[strip off text before #!perl line and perhaps cd to directory]:directory to cd to:_files -/' \
+    '1:Perl script:_files -/ -g \*.p\[ml\]' \
+    '*::args: _normal' 
+}
+
+_perl_m_opt () {
+  compset -P '-'
+
+  if compset -P '*='; then
+    _message 'module arguments, comma separated'
+  else
+    _perl_modules -S= -q
+  fi
+}
+
+_perl_config_vars () {
+  if (( ! $+_perl_config_vars )); then
+    _perl_config_vars=( $(perl -MConfig -e 'print join("\n", keys %Config);') )
+  fi
+
+  local add_colon='-P:'
+  compset -P '*:' && add_colon=''
+
+  local delimiter='\ '
+  (( compstate[quoting] )) && delimiter=' '
+
+  compset -P '* ' && compset -q
+  compadd "$expl[@]" $add_colon -S$delimiter -q -a _perl_config_vars
+}
+
+_perl "$@"
diff --git a/Src/builtin.c b/Src/builtin.c
index cbc69b599..b51f61e27 100644
--- a/Src/builtin.c
+++ b/Src/builtin.c
@@ -3031,9 +3031,11 @@ bin_print(char *name, char **args, char *ops, int func)
 	    } while (*ap);
 	    fputc(ops['N'] ? '\0' : '\n', fout);
 	}
-	if (((fout != stdout) ? fclose(fout) : fflush(fout)) != 0) {
-	    zwarnnam(name, "write error: %e", NULL, errno);
-	    ret = 1;
+	/* Testing EBADF special-cases >&- redirections */
+	if ((fout != stdout) ? (fclose(fout) != 0) :
+	    (fflush(fout) != 0 && errno != EBADF)) {
+            zwarnnam(name, "write error: %e", NULL, errno);
+            ret = 1;
 	}
 	return ret;
     }
@@ -3045,7 +3047,9 @@ bin_print(char *name, char **args, char *ops, int func)
     }
     if (!(ops['n'] || nnl))
 	fputc(ops['N'] ? '\0' : '\n', fout);
-    if (((fout != stdout) ? fclose(fout) : fflush(fout)) != 0) {
+    /* Testing EBADF special-cases >&- redirections */
+    if ((fout != stdout) ? (fclose(fout) != 0) :
+	(fflush(fout) != 0 && errno != EBADF)) {
 	zwarnnam(name, "write error: %e", NULL, errno);
 	ret = 1;
     }
diff --git a/Test/E01options.ztst b/Test/E01options.ztst
index f93012020..99f9f6fae 100644
--- a/Test/E01options.ztst
+++ b/Test/E01options.ztst
@@ -193,7 +193,6 @@
   unsetopt cdablevars
   cd cdablevar2
 1q:CDABLE_VARS option
->`print -P '%~'`/tmpcd
 >back in options.tmp
 ?ZTST_execchunk:cd:2: no such file or directory: cdablevar1
 ?ZTST_execchunk:cd:2: no such file or directory: cdablevar2
@@ -769,9 +768,7 @@
   cd $mydir  
 0q:PUSHD_MINUS option
 >$mydirt/newcd $mydirt/tmpcd $mydirt
->$mydirt
 >$mydirt $mydirt/newcd $mydirt/tmpcd
->$mydirt
 >$mydirt $mydirt/newcd $mydirt/tmpcd
 
 # Do you have any idea how dull this is?