From f6915f51c2244fe7303d38ddc747055d64b72820 Mon Sep 17 00:00:00 2001
From: Chad Elliott <elliottc@objectcomputing.com>
Date: Thu, 17 Nov 2022 07:55:25 -0600
Subject: Corrected problems with generation of CMake workspaces with
 directories above or outside of the directory of the workspace.

---
 modules/CMakeWorkspaceCreator.pm | 40 +++++++++++++++++++++++++---------------
 modules/DirectoryManager.pm      | 24 ++++++++++++++++++++++++
 2 files changed, 49 insertions(+), 15 deletions(-)

diff --git a/modules/CMakeWorkspaceCreator.pm b/modules/CMakeWorkspaceCreator.pm
index 6a9d994a..ceca1cbe 100644
--- a/modules/CMakeWorkspaceCreator.pm
+++ b/modules/CMakeWorkspaceCreator.pm
@@ -51,24 +51,34 @@ sub pre_workspace {
            '# ', $self->create_command_line_string($0, @ARGV), $crlf);
 }
 
+## Get the top level directory in the path.  If the path does not contain
+## a directory, the path will be returned unmodified.
 sub get_top_directory {
   my($self, $path) = @_;
 
-  ## Get the top level directory in the path.  If the path does not contain
-  ## a directory, the path will be returned unmodified.
-  my $dir = $path;
-  my $done = 0;
-  do {
-    ## Go up one directory.  If we were already at the top directory,
-    ## we're finished.
-    my $next = $self->mpc_dirname($dir);
-    if ($next eq '.') {
-      $done = 1;
-    }
-    else {
-      $dir = $next;
-    }
-  } while(!$done);
+  ## First, convert the path to a relative path based on the current working
+  ## directory.
+  my $dir = $self->path_to_relative($self->getcwd(), $path);
+  if ($dir =~ /^\.\.\// || !$self->path_is_relative($dir)) {
+    ## If the directory is above the current directory or not relative to
+    ## the current working directory, we need to give the directory portion
+    ## back and call it a day.
+    return $self->mpc_dirname($dir);
+  }
+  else {
+    my $done = 0;
+    do {
+      ## Go up one directory.  If we were already at the top directory,
+      ## we're finished.
+      my $next = $self->mpc_dirname($dir);
+      if ($next eq '.') {
+        $done = 1;
+      }
+      else {
+        $dir = $next;
+      }
+    } while(!$done);
+  }
 
   return $dir;
 }
diff --git a/modules/DirectoryManager.pm b/modules/DirectoryManager.pm
index 6dfdd92d..bdc23151 100644
--- a/modules/DirectoryManager.pm
+++ b/modules/DirectoryManager.pm
@@ -199,6 +199,30 @@ sub path_is_relative {
   return (index($_[1], '/') != 0 && $_[1] !~ /^[A-Z]:[\/\\]/i && $_[1] !~ /^\$\(\w+\)/);
 }
 
+sub path_to_relative {
+  my($self, $check, $path) = @_;
+
+  ## See if it's already relative.  If it is, there's nothing to do.
+  if ($path !~ s/^.[\/]+// && !$self->path_is_relative($path)) {
+    ## See how many times we have to chop off a directory until we find that
+    ## the provided path contains part of the current working directory.
+    my $dircount = 0;
+    while($check ne '.' && index($path, $check) != 0) {
+      $dircount++;
+      $check = $self->mpc_dirname($check);
+    }
+
+    ## If we didn't go all the way back up the current working directory, we
+    ## can create a relative path from it based on the number of directories
+    ## we removed above.
+    if ($check ne '.') {
+      $path = ('../' x $dircount) . substr($path, length($check) + 1);
+    }
+  }
+
+  return $path;
+}
+
 # ************************************************************
 # Virtual Methods To Be Overridden
 # ************************************************************
-- 
cgit v1.2.1