[m-rev.] diff: fix --use-grade-subdirs and --grade erlang on systems w/o symlinks

[Julien Fischer]

Branches: main, 11.01

Fix a problem with --use-grade-subdirs and the erlang grade on systems that
don't support symbolic links.  Erlang "archives" are just directories of .beam
files so when copying them to the working directory we need to copy them as
directories, e.g. cp -r, rather than as files.  (On systems that do support
symbolic links we just create a symlink so the issue doesn't arise.)

compiler/compile_target_code.m:
 	When --use-grade-subdirs is enabled copy Erlang archives as
 	directories rather than as files.

compiler/module_cmds.m:
 	Add a new predicate, make_symlink_or_copy_dir/6, for use by the above.

Julien.

Index: compiler/compile_target_code.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/compile_target_code.m,v
retrieving revision 1.166
diff -u -r1.166 compile_target_code.m
--- compiler/compile_target_code.m	1 Feb 2011 14:03:17 -0000	1.166
+++ compiler/compile_target_code.m	27 Feb 2011 06:32:49 -0000
@@ -2404,8 +2404,17 @@
              io.set_output_stream(ErrorStream, OutputStream, !IO),
              % Remove the target of the symlink/copy in case it already exists.
              io.remove_file_recursively(UserDirFileName, _, !IO),
-            make_symlink_or_copy_file(Globals, OutputFileName, UserDirFileName,
-                Succeeded, !IO),
+
+            % Erlang "archives" are just directories of .beam files, so we need
+            % to copy them as directories rather than files (on systems on which
+            % symbolic links are not available).
+            ( if LinkTargetType = erlang_archive then
+                make_symlink_or_copy_dir(Globals, OutputFileName,
+                    UserDirFileName, Succeeded, !IO)
+              else
+                make_symlink_or_copy_file(Globals, OutputFileName,
+                    UserDirFileName, Succeeded, !IO)
+            ),
              io.set_output_stream(OutputStream, _, !IO),
              MadeSymlinkOrCopy = yes
          )
Index: compiler/module_cmds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/module_cmds.m,v
retrieving revision 1.19
diff -u -r1.19 module_cmds.m
--- compiler/module_cmds.m	9 Jan 2011 14:56:11 -0000	1.19
+++ compiler/module_cmds.m	27 Feb 2011 06:32:49 -0000
@@ -69,6 +69,11 @@
  :- pred make_symlink_or_copy_file(globals::in, file_name::in, file_name::in,
      bool::out, io::di, io::uo) is det.

+    % As above, but for when LinkTarget is a directory rather than a file.
+    %
+:- pred make_symlink_or_copy_dir(globals::in, file_name::in, file_name::in,
+    bool::out, io::di, io::uo) is det.
+
  %-----------------------------------------------------------------------------%

      % touch_interface_datestamp(Globals, ModuleName, Ext, !IO):
@@ -399,6 +404,19 @@
          )
      ).

+:- pred copy_dir(globals::in, dir_name::in, dir_name::in, bool::out,
+    io::di, io::uo) is det.
+
+copy_dir(Globals, Source, Destination, Succeeded, !IO) :-
+    globals.lookup_string_option(Globals, install_command, InstallCommand),
+    globals.lookup_string_option(Globals, install_command_dir_option,
+        InstallCommandDirOption),
+    Command = string.join_list("   ", list.map(quote_arg,
+        [InstallCommand, InstallCommandDirOption, Source, Destination])),
+    io.output_stream(OutputStream, !IO),
+    invoke_system_command(Globals, OutputStream, cmd_verbose, Command,
+        Succeeded, !IO).
+
  maybe_make_symlink(Globals, LinkTarget, LinkName, Result, !IO) :-
      globals.lookup_bool_option(Globals, use_symlinks, UseSymLinks),
      (
@@ -443,6 +461,49 @@
          io.flush_output(!IO)
      ).

+make_symlink_or_copy_dir(Globals, SourceDirName, DestinationDirName,
+        Succeeded, !IO) :-
+    globals.lookup_bool_option(Globals, use_symlinks, UseSymLinks),
+    (
+        UseSymLinks = yes,
+        io.make_symlink(SourceDirName, DestinationDirName, Result, !IO),
+        (
+            Result = ok,
+            Succeeded = yes
+        ;
+            Result = error(Error),
+            Succeeded = no,
+            io.progname_base("mercury_compile", ProgName, !IO),
+            io.write_string(ProgName, !IO),
+            io.write_string(": error linking", !IO),
+            io.write_string(" `", !IO),
+            io.write_string(SourceDirName, !IO),
+            io.write_string("' to `", !IO),
+            io.write_string(DestinationDirName, !IO),
+            io.write_string("': ", !IO),
+            io.write_string(io.error_message(Error), !IO),
+            io.nl(!IO),
+            io.flush_output(!IO)
+        )
+    ;
+        UseSymLinks = no,
+        copy_dir(Globals, SourceDirName, DestinationDirName, Succeeded, !IO),
+        (
+            Succeeded = yes
+        ;
+            Succeeded = no, 
+            io.progname_base("mercury_compile", ProgName, !IO),
+            io.write_string(ProgName, !IO),
+            io.write_string(": error copying directory", !IO),
+            io.write_string(" `", !IO),
+            io.write_string(SourceDirName, !IO),
+            io.write_string("' to `", !IO),
+            io.write_string(DestinationDirName, !IO),
+            io.nl(!IO),
+            io.flush_output(!IO)
+        )
+    ).
+
  %-----------------------------------------------------------------------------%

  touch_interface_datestamp(Globals, ModuleName, Ext, !IO) :-

--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------