
(********************************************************************)
(*                                                                  *)
(*  chkcmd.sd7    Check functions that manipulate files.            *)
(*  Copyright (C) 2014  Thomas Mertes                               *)
(*                                                                  *)
(*  This program is free software; you can redistribute it and/or   *)
(*  modify it under the terms of the GNU General Public License as  *)
(*  published by the Free Software Foundation; either version 2 of  *)
(*  the License, or (at your option) any later version.             *)
(*                                                                  *)
(*  This program is distributed in the hope that it will be useful, *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of  *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the   *)
(*  GNU General Public License for more details.                    *)
(*                                                                  *)
(*  You should have received a copy of the GNU General Public       *)
(*  License along with this program; if not, write to the           *)
(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
(*                                                                  *)
(********************************************************************)


$ include "seed7_05.s7i";
  include "osfiles.s7i";
  include "getf.s7i";
  include "utf8.s7i";


const proc: check_removeFile is func
  local
    const string: fileName is "remove_file_test";
    var boolean: okay is TRUE;
    var boolean: fileErrorRaised is FALSE;
  begin
    mkdir(fileName);
    putf(fileName & "/" & fileName, "File content check_removeFile 1");
    fileErrorRaised := FALSE;
    block
      removeFile(fileName);
    exception
      catch FILE_ERROR:
        fileErrorRaised := TRUE;
    end block;
    if not fileErrorRaised then
      writeln(" ***** removeFile with nonempty directory does not raise FILE_ERROR.");
      okay := FALSE;
    end if;

    block
      removeFile(fileName & "/" & fileName);
    exception
      catch FILE_ERROR:
        writeln(" ***** removeFile with a regular file raises FILE_ERROR");
        okay := FALSE;
    end block;

    block
      removeFile(fileName);
    exception
      catch FILE_ERROR:
        writeln(" ***** removeFile with an empty directory raises FILE_ERROR");
        okay := FALSE;
    end block;

    if okay then
      writeln("Removing regular files and empty directories with removeFile works correct.");
    else
      writeln(" ***** Removing regular files and empty directories with removeFile does not work correct.");
      writeln;
    end if;
  end func;


const proc: check_removeTree is func
  local
    const string: fileName is "remove_tree_test";
    var boolean: okay is TRUE;
  begin
    putf(fileName, "File content check_removeTree 1");
    block
      removeTree(fileName);
    exception
      catch FILE_ERROR:
        writeln(" ***** removeTree with a regular file raises FILE_ERROR");
        okay := FALSE;
    end block;

    mkdir(fileName);
    block
      removeTree(fileName);
    exception
      catch FILE_ERROR:
        writeln(" ***** removeTree with an empty directory raises FILE_ERROR");
        okay := FALSE;
    end block;

    mkdir(fileName);
    putf(fileName & "/" & fileName, "File content check_removeTree 2");
    block
      removeTree(fileName);
    exception
      catch FILE_ERROR:
        writeln(" ***** removeTree a directory tree raises FILE_ERROR");
        okay := FALSE;
    end block;

    if okay then
      writeln("Removing regular files and directories with removeTree works correct.");
    else
      writeln(" ***** Removing regular files and empty directories with removeTree does not work correct.");
      writeln;
    end if;
  end func;


const proc: check_copyFile is func
  local
    const string: fileName1 is "asdf_file_test";
    const string: fileName2 is "jkl_file_test";
    var boolean: okay is TRUE;
    var boolean: fileErrorRaised is FALSE;
  begin
    putf(fileName1, "File content check_copyFile 1");
    putf(fileName2, "File content check_copyFile 2");
    fileErrorRaised := FALSE;
    block
      copyFile(fileName1, fileName2);
    exception
      catch FILE_ERROR:
        fileErrorRaised := TRUE;
    end block;
    if not fileErrorRaised then
      writeln(" ***** copyFile to existing file does not raise FILE_ERROR.");
      okay := FALSE;
    end if;
    removeFile(fileName1);
    removeFile(fileName2);

    putf(fileName1, "File content check_copyFile 3");
    mkdir(fileName2);
    fileErrorRaised := FALSE;
    block
      copyFile(fileName1, fileName2);
    exception
      catch FILE_ERROR:
        fileErrorRaised := TRUE;
    end block;
    if not fileErrorRaised then
      writeln(" ***** copyFile to existing file does not raise FILE_ERROR.");
      okay := FALSE;
    end if;
    removeFile(fileName1);
    removeFile(fileName2);

    mkdir(fileName1);
    putf(fileName2, "File content check_copyFile 4");
    fileErrorRaised := FALSE;
    block
      copyFile(fileName1, fileName2);
    exception
      catch FILE_ERROR:
        fileErrorRaised := TRUE;
    end block;
    if not fileErrorRaised then
      writeln(" ***** copyFile to existing file does not raise FILE_ERROR.");
      okay := FALSE;
    end if;
    removeFile(fileName1);
    removeFile(fileName2);

    mkdir(fileName1);
    mkdir(fileName2);
    fileErrorRaised := FALSE;
    block
      copyFile(fileName1, fileName2);
    exception
      catch FILE_ERROR:
        fileErrorRaised := TRUE;
    end block;
    if not fileErrorRaised then
      writeln(" ***** copyFile to existing file does not raise FILE_ERROR.");
      okay := FALSE;
    end if;
    removeFile(fileName1);
    removeFile(fileName2);

    putf(fileName1, "File content check_copyFile 5");
    block
      copyFile(fileName1, fileName2);
    exception
      catch FILE_ERROR:
        writeln(" ***** copyFile with a regular file raises FILE_ERROR.");
        okay := FALSE;
    end block;
    if fileType(fileName1) = FILE_ABSENT then
      writeln(" ***** copyFile does remove the old file.");
      okay := FALSE;
    else
      removeFile(fileName1);
    end if;
    if fileType(fileName2) = FILE_ABSENT then
      writeln(" ***** copyFile does not create the destination.");
      okay := FALSE;
    elsif fileType(fileName2) <> FILE_REGULAR then
      writeln(" ***** copyFile creates destination with wrong file type.");
      okay := FALSE;
      removeFile(fileName2);
    else
      if getf(fileName2) <> "File content check_copyFile 5" then
        writeln(" ***** copyFile creates destination with wrong content.");
        okay := FALSE;
      end if;
      removeFile(fileName2);
    end if;

    mkdir(fileName1);
    block
      copyFile(fileName1, fileName2);
    exception
      catch FILE_ERROR:
        writeln(" ***** copyFile with an empty directory raises FILE_ERROR.");
        okay := FALSE;
    end block;
    if fileType(fileName1) = FILE_ABSENT then
      writeln(" ***** copyFile does remove the old file.");
      okay := FALSE;
    else
      removeFile(fileName1);
    end if;
    if fileType(fileName2) = FILE_ABSENT then
      writeln(" ***** copyFile does not create the destination.");
      okay := FALSE;
    elsif fileType(fileName2) <> FILE_DIR then
      writeln(" ***** copyFile creates destination with wrong file type.");
      okay := FALSE;
      removeFile(fileName2);
    else
      if readDir(fileName2) <> 0 times "" then
        writeln(" ***** copyFile creates destination directory with wrong content.");
        okay := FALSE;
      end if;
      removeFile(fileName2);
    end if;

    mkdir(fileName1);
    putf(fileName1 & "/" & fileName1, "File content check_copyFile 6");
    block
      copyFile(fileName1, fileName2);
    exception
      catch FILE_ERROR:
        writeln(" ***** copyFile with a directory raises FILE_ERROR.");
        okay := FALSE;
    end block;
    if fileType(fileName1) = FILE_ABSENT then
      writeln(" ***** copyFile does remove the old file.");
      okay := FALSE;
    else
      removeTree(fileName1);
    end if;
    if fileType(fileName2) = FILE_ABSENT then
      writeln(" ***** copyFile does not create the destination.");
      okay := FALSE;
    elsif fileType(fileName2) <> FILE_DIR then
      writeln(" ***** copyFile creates destination with wrong file type.");
      okay := FALSE;
      removeFile(fileName2);
    else
      if length(readDir(fileName2)) <> 1 or
          readDir(fileName2)[1] <> fileName1 then
        writeln(" ***** copyFile creates destination directory with wrong content.");
        okay := FALSE;
      elsif getf(fileName2 & "/" & fileName1) <> "File content check_copyFile 6" then
        writeln(" ***** copyFile creates destination file with wrong content.");
        okay := FALSE;
      end if;
      removeTree(fileName2);
    end if;

    mkdir(fileName1);
    mkdir(fileName2);
    putf(fileName1 & "/" & fileName1, "File content check_copyFile 7");
    block
      copyFile(fileName1 & "/" & fileName1, fileName2 & "/" & fileName2);
    exception
      catch FILE_ERROR:
        writeln(" ***** copyFile with an empty directory raises FILE_ERROR.");
        okay := FALSE;
    end block;
    if fileType(fileName1 & "/" & fileName1) = FILE_ABSENT then
      writeln(" ***** copyFile does remove the old file.");
      okay := FALSE;
    else
      removeFile(fileName1 & "/" & fileName1);
    end if;
    if fileType(fileName2 & "/" & fileName2) = FILE_ABSENT then
      writeln(" ***** copyFile does not create the destination.");
      okay := FALSE;
    elsif fileType(fileName2 & "/" & fileName2) <> FILE_REGULAR then
      writeln(" ***** copyFile creates destination with wrong file type.");
      okay := FALSE;
      removeFile(fileName2 & "/" & fileName2);
    else
      if getf(fileName2 & "/" & fileName2) <> "File content check_copyFile 7" then
        writeln(" ***** copyFile creates destination file with wrong content.");
        okay := FALSE;
      end if;
      removeFile(fileName2 & "/" & fileName2);
    end if;
    removeTree(fileName1);
    removeTree(fileName2);

    mkdir(fileName1);
    mkdir(fileName2);
    mkdir(fileName1 & "/" & fileName1);
    block
      copyFile(fileName1 & "/" & fileName1, fileName2 & "/" & fileName2);
    exception
      catch FILE_ERROR:
        writeln(" ***** copyFile with an empty directory raises FILE_ERROR.");
        okay := FALSE;
    end block;
    if fileType(fileName1 & "/" & fileName1) = FILE_ABSENT then
      writeln(" ***** copyFile does remove the old file.");
      okay := FALSE;
    else
      removeFile(fileName1 & "/" & fileName1);
    end if;
    if fileType(fileName2 & "/" & fileName2) = FILE_ABSENT then
      writeln(" ***** copyFile does not create the destination.");
      okay := FALSE;
    elsif fileType(fileName2 & "/" & fileName2) <> FILE_DIR then
      writeln(" ***** copyFile creates destination with wrong file type.");
      okay := FALSE;
      removeFile(fileName2 & "/" & fileName2);
    else
      if readDir(fileName2 & "/" & fileName2) <> 0 times "" then
        writeln(" ***** copyFile creates destination directory with wrong content.");
        okay := FALSE;
      end if;
      removeFile(fileName2 & "/" & fileName2);
    end if;
    removeTree(fileName1);
    removeTree(fileName2);

    if okay then
      writeln("Copying files with copyFile works correct.");
    else
      writeln(" ***** Copying files with copyFile does not work correct.");
      writeln;
    end if;
  end func;


const proc: check_moveFile is func
  local
    const string: fileName1 is "asdf_file_test";
    const string: fileName2 is "jkl_file_test";
    var boolean: okay is TRUE;
    var boolean: fileErrorRaised is FALSE;
  begin
    putf(fileName1, "File content check_moveFile 1");
    putf(fileName2, "File content check_moveFile 2");
    fileErrorRaised := FALSE;
    block
      moveFile(fileName1, fileName2);
    exception
      catch FILE_ERROR:
        fileErrorRaised := TRUE;
    end block;
    if not fileErrorRaised then
      writeln(" ***** moveFile to existing file does not raise FILE_ERROR.");
      okay := FALSE;
    end if;
    removeFile(fileName1);
    removeFile(fileName2);

    putf(fileName1, "File content check_moveFile 3");
    mkdir(fileName2);
    fileErrorRaised := FALSE;
    block
      moveFile(fileName1, fileName2);
    exception
      catch FILE_ERROR:
        fileErrorRaised := TRUE;
    end block;
    if not fileErrorRaised then
      writeln(" ***** moveFile to existing file does not raise FILE_ERROR.");
      okay := FALSE;
    end if;
    removeFile(fileName1);
    removeFile(fileName2);

    mkdir(fileName1);
    putf(fileName2, "File content check_moveFile 4");
    fileErrorRaised := FALSE;
    block
      moveFile(fileName1, fileName2);
    exception
      catch FILE_ERROR:
        fileErrorRaised := TRUE;
    end block;
    if not fileErrorRaised then
      writeln(" ***** moveFile to existing file does not raise FILE_ERROR.");
      okay := FALSE;
    end if;
    removeFile(fileName1);
    removeFile(fileName2);

    mkdir(fileName1);
    mkdir(fileName2);
    fileErrorRaised := FALSE;
    block
      moveFile(fileName1, fileName2);
    exception
      catch FILE_ERROR:
        fileErrorRaised := TRUE;
    end block;
    if not fileErrorRaised then
      writeln(" ***** moveFile to existing file does not raise FILE_ERROR.");
      okay := FALSE;
    end if;
    removeFile(fileName1);
    removeFile(fileName2);

    putf(fileName1, "File content check_moveFile 5");
    block
      moveFile(fileName1, fileName2);
    exception
      catch FILE_ERROR:
        writeln(" ***** moveFile with a regular file raises FILE_ERROR.");
        okay := FALSE;
    end block;
    if fileType(fileName1) <> FILE_ABSENT then
      writeln(" ***** moveFile does not remove the old file.");
      okay := FALSE;
      removeFile(fileName1);
    end if;
    if fileType(fileName2) = FILE_ABSENT then
      writeln(" ***** moveFile does not create the destination.");
      okay := FALSE;
    elsif fileType(fileName2) <> FILE_REGULAR then
      writeln(" ***** moveFile creates destination with wrong file type.");
      okay := FALSE;
      removeFile(fileName2);
    else
      if getf(fileName2) <> "File content check_moveFile 5" then
        writeln(" ***** moveFile creates destination with wrong content.");
        okay := FALSE;
      end if;
      removeFile(fileName2);
    end if;

    mkdir(fileName1);
    block
      moveFile(fileName1, fileName2);
    exception
      catch FILE_ERROR:
        writeln(" ***** moveFile with an empty directory raises FILE_ERROR.");
        okay := FALSE;
    end block;
    if fileType(fileName1) <> FILE_ABSENT then
      writeln(" ***** moveFile does not remove the old file.");
      okay := FALSE;
      removeFile(fileName1);
    end if;
    if fileType(fileName2) = FILE_ABSENT then
      writeln(" ***** moveFile does not create the destination.");
      okay := FALSE;
    elsif fileType(fileName2) <> FILE_DIR then
      writeln(" ***** moveFile creates destination with wrong file type.");
      okay := FALSE;
      removeFile(fileName2);
    else
      if readDir(fileName2) <> 0 times "" then
        writeln(" ***** moveFile creates destination directory with wrong content.");
        okay := FALSE;
      end if;
      removeFile(fileName2);
    end if;

    mkdir(fileName1);
    putf(fileName1 & "/" & fileName1, "File content check_moveFile 6");
    block
      moveFile(fileName1, fileName2);
    exception
      catch FILE_ERROR:
        writeln(" ***** moveFile with a directory raises FILE_ERROR.");
        okay := FALSE;
    end block;
    if fileType(fileName1) <> FILE_ABSENT then
      writeln(" ***** moveFile does not remove the old file.");
      okay := FALSE;
      removeFile(fileName1);
    end if;
    if fileType(fileName2) = FILE_ABSENT then
      writeln(" ***** moveFile does not create the destination.");
      okay := FALSE;
    elsif fileType(fileName2) <> FILE_DIR then
      writeln(" ***** moveFile creates destination with wrong file type.");
      okay := FALSE;
      removeFile(fileName2);
    else
      if length(readDir(fileName2)) <> 1 or
          readDir(fileName2)[1] <> fileName1 then
        writeln(" ***** moveFile creates destination directory with wrong content.");
        okay := FALSE;
      elsif getf(fileName2 & "/" & fileName1) <> "File content check_moveFile 6" then
        writeln(" ***** moveFile creates destination file with wrong content.");
        okay := FALSE;
      end if;
      removeTree(fileName2);
    end if;

    mkdir(fileName1);
    mkdir(fileName2);
    putf(fileName1 & "/" & fileName1, "File content check_moveFile 7");
    block
      moveFile(fileName1 & "/" & fileName1, fileName2 & "/" & fileName2);
    exception
      catch FILE_ERROR:
        writeln(" ***** moveFile with an empty directory raises FILE_ERROR.");
        okay := FALSE;
    end block;
    if fileType(fileName1 & "/" & fileName1) <> FILE_ABSENT then
      writeln(" ***** moveFile does not remove the old file.");
      okay := FALSE;
      removeFile(fileName1 & "/" & fileName1);
    end if;
    if fileType(fileName2 & "/" & fileName2) = FILE_ABSENT then
      writeln(" ***** moveFile does not create the destination.");
      okay := FALSE;
    elsif fileType(fileName2 & "/" & fileName2) <> FILE_REGULAR then
      writeln(" ***** moveFile creates destination with wrong file type.");
      okay := FALSE;
      removeFile(fileName2 & "/" & fileName2);
    else
      if getf(fileName2 & "/" & fileName2) <> "File content check_moveFile 7" then
        writeln(" ***** moveFile creates destination file with wrong content.");
        okay := FALSE;
      end if;
      removeFile(fileName2 & "/" & fileName2);
    end if;
    removeTree(fileName1);
    removeTree(fileName2);

    mkdir(fileName1);
    mkdir(fileName2);
    mkdir(fileName1 & "/" & fileName1);
    block
      moveFile(fileName1 & "/" & fileName1, fileName2 & "/" & fileName2);
    exception
      catch FILE_ERROR:
        writeln(" ***** moveFile with an empty directory raises FILE_ERROR.");
        okay := FALSE;
    end block;
    if fileType(fileName1 & "/" & fileName1) <> FILE_ABSENT then
      writeln(" ***** moveFile does not remove the old file.");
      okay := FALSE;
      removeFile(fileName1 & "/" & fileName1);
    end if;
    if fileType(fileName2 & "/" & fileName2) = FILE_ABSENT then
      writeln(" ***** moveFile does not create the destination.");
      okay := FALSE;
    elsif fileType(fileName2 & "/" & fileName2) <> FILE_DIR then
      writeln(" ***** moveFile creates destination with wrong file type.");
      okay := FALSE;
      removeFile(fileName2 & "/" & fileName2);
    else
      if readDir(fileName2 & "/" & fileName2) <> 0 times "" then
        writeln(" ***** moveFile creates destination directory with wrong content.");
        okay := FALSE;
      end if;
      removeFile(fileName2 & "/" & fileName2);
    end if;
    removeTree(fileName1);
    removeTree(fileName2);

    if okay then
      writeln("Moving files with moveFile works correct.");
    else
      writeln(" ***** Moving files with moveFile does not work correct.");
      writeln;
    end if;
  end func;


const func string: randomString (in integer: length) is func
  result
    var string: randomString is "";
  local
    var integer: pos is 0;
  begin
    for pos range 1 to length do
      randomString &:= rand('A', 'Z');
    end for;
  end func;


const func string: randomNameNotInEnvironment is func
  result
    var string: randomName is "";
  local
    var string: name is "";
    var boolean: found is FALSE;
  begin
    repeat
      randomName := randomString(10);
      found := FALSE;
      for name range environment until found do
        if randomName = name then
          found := TRUE;
        end if;
      end for;
    until not found;
  end func;


const proc: check_environment is func
  local
    var string: name is "";
    var string: value is "";
    var string: randomName is "";
    var string: randomValue is "";
    var boolean: found is FALSE;
    var boolean: okay is TRUE;
  begin
    # Get the values of all environment variables.
    for name range environment do
      if getenv(name) <> "" then
        found := TRUE;
      end if;
    end for;
    if length(environment) <> 0 and not found then
      writeln(" ***** All environment variables have \"\" as value.");
      okay := FALSE;
    end if;

    randomName := randomNameNotInEnvironment;
    if getenv(randomName) <> "" then
      writeln(" ***** getenv succeeds for non-existing environment variable.");
      okay := FALSE;
    end if;
    for name range environment do
      if randomName = name then
        writeln(" ***** New environment variable exists already in the environment.");
        okay := FALSE;
      end if;
    end for;

    randomValue := randomString(10);
    setenv(randomName, randomValue);
    if getenv(randomName) <> randomValue then
      writeln(" ***** Setting an environment variable does not work correct.");
      okay := FALSE;
    end if;
    found := FALSE;
    for name range environment do
      if randomName = name then
        found := TRUE;
      end if;
    end for;
    if not found then
      writeln(" ***** New environment variable does not exist in the environment after beeing set.");
      okay := FALSE;
    end if;

    randomValue := randomString(10);
    setenv(randomName, randomValue);
    if getenv(randomName) <> randomValue then
      writeln(" ***** Changing an environment variable does not work correct.");
      okay := FALSE;
    end if;

    if okay then
      writeln("Getting and setting environment variables works correct.");
    else
      writeln(" ***** Getting and setting environment variables does not work correct.");
      writeln;
    end if;
  end func;


const proc: main is func
  begin
    writeln;
    writeln("Note that windows has race conditions when files");
    writeln("are copied, moved and removed quickly in succession.");
    writeln("This bug of windows cannot be fixed in a runtime library.");
    check_removeFile;
    check_removeTree;
    check_copyFile;
    check_moveFile;
    check_environment;
  end func;
