From d9c4b2a88cc2c67a826bfefe8f9c99d29b0a8144 Mon Sep 17 00:00:00 2001
From: Daniel Kochmanski <daniel@turtleware.eu>
Date: Sun, 6 May 2018 08:20:54 +0200
Subject: [PATCH] Add explicit :TRUNCATE option for :IF-EXISTS in OPEN

In the future we may want to make :SUPERSEDE transaction-like.
---
 src/c/file.d          | 7 ++++++-
 src/c/symbols_list.h  | 1 +
 src/c/symbols_list2.h | 1 +
 src/doc/help.lsp      | 6 +++---
 4 files changed, 11 insertions(+), 4 deletions(-)

diff --git a/src/c/file.d b/src/c/file.d
index 961841ef2..227d34c6b 100755
--- a/src/c/file.d
+++ b/src/c/file.d
@@ -5107,7 +5107,12 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists,
         unlikely_if (f < 0) FEcannot_open(fn);
       } else if (if_exists == @':rename_and_delete' ||
                  if_exists == @':new_version' ||
-                 if_exists == @':supersede') {
+                 /* :SUPERSEDE could write to a new file and only upon succesful
+                    close it could replace the file in question. That way we'd
+                    assure a transaction-like behavior. We add :TRUNACTE for
+                    explicit truncate action. */
+                 if_exists == @':supersede' ||
+                 if_exists == @':truncate') {
         f = safe_open(fname, base|O_TRUNC, mode);
         unlikely_if (f < 0) FEcannot_open(fn);
       } else if (if_exists == @':overwrite' || if_exists == @':append') {
diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h
index 146b27a22..24d4df9e4 100755
--- a/src/c/symbols_list.h
+++ b/src/c/symbols_list.h
@@ -1435,6 +1435,7 @@ cl_symbols[] = {
 {KEY_ "TAG", KEYWORD, NULL, -1, OBJNULL},
 {KEY_ "TEST", KEYWORD, NULL, -1, OBJNULL},
 {KEY_ "TEST-NOT", KEYWORD, NULL, -1, OBJNULL},
+{KEY_ "TRUNCATE", KEYWORD, NULL, -1, OBJNULL},
 {KEY_ "TYPE", KEYWORD, NULL, -1, OBJNULL},
 {KEY_ "UNSPECIFIC", KEYWORD, NULL, -1, OBJNULL},
 {KEY_ "UNMASK", KEYWORD, NULL, -1, OBJNULL},
diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h
index e74b74a38..88918f243 100644
--- a/src/c/symbols_list2.h
+++ b/src/c/symbols_list2.h
@@ -1435,6 +1435,7 @@ cl_symbols[] = {
 {KEY_ "TAG",NULL},
 {KEY_ "TEST",NULL},
 {KEY_ "TEST-NOT",NULL},
+{KEY_ "TRUNCATE",NULL},
 {KEY_ "TYPE",NULL},
 {KEY_ "UNSPECIFIC",NULL},
 {KEY_ "UNMASK",NULL},
diff --git a/src/doc/help.lsp b/src/doc/help.lsp
index 753ff1d0b..daf2a54e4 100644
--- a/src/doc/help.lsp
+++ b/src/doc/help.lsp
@@ -2263,9 +2263,9 @@ FILESPEC may be a symbol, a string, a pathname, or a file stream.
 
 DIRECTION may be :INPUT, :OUTPUT, :IO, or :PROBE.
 
-IF-EXISTS specifies what to do when DIRECTION is either :OUTPUT or :IO
-and the specified file exists already.  It may be :ERROR (the
-default), :NEW-VERSION, :RENAME, :RENAME-AND-DELETE, :OVERWRITE, :APPEND,
+IF-EXISTS specifies what to do when DIRECTION is either :OUTPUT or :IO and the
+specified file exists already.  It may be :ERROR (the
+default), :NEW-VERSION, :RENAME, :RENAME-AND-DELETE, :OVERWRITE, :APPEND, :TRUNCATE
 :SUPERSEDE, or NIL.
 
 IF-DOES-NOT-EXIST specifies what to do when the specified file does