Re: PATCH: add relative_file_name procedure to encapsulate logic for "subdir" variable [revised]

[Jacob Bachmeyer]

Ben Elliston wrote:
> On Mon, Dec 03, 2018 at 11:29:47PM -0600, Jacob Bachmeyer wrote:
>   
> > In other words, it probably should remain as "relative_file_name",
> > since "realpath_relative" implies a different (and more extensive
> > operation) as I see it.  At the least, "realpath_relative" would
> > apply "file normalize" to both arguments unconditionally, even
> > though this could produce surprising results in some situations
> > involving edge cases with symlinks.  Those edge cases would also be
> > hard to debug, since users bit by them may not realize that symlinks
> > are involved in the problem.  As a pure utility procedure,
> > "realpath" and variants could be useful, but could be dangerous to
> > call from the core due to this sensitivity to the filesystem that
> > this patch lacks.
> >     
>
> Thanks for thinking about the suggestion -- I agree. I'm happy with
> that, but can we use 'filename' without an underscore?  It's a very
> common convention and one less character to type. ;-)
>   

While the GNU Coding Standards suggest using "file name" specifically; a 
quick grep shows that DejaGnu already has proc unix_clean_filename and 
no procedures that use "file_name" in their names, so consistency 
suggests that the change should be made.  A revised patch follows.

I do not see a difference either way as far as typing less:  
relativ<M-/> is the same either way for me.  :-)

----
ChangeLog entries:
        * runtest.exp: Use new relative_filename procedure.

        * doc/dejagnu.texi (relative_filename procedure): Add.
        * lib/utils.exp (relative_filename): Add.
        * testsuite/runtest.all/utils.test: Add tests for relative_filename.
----
patch:
----
diff --git a/doc/dejagnu.texi b/doc/dejagnu.texi
index d6f6881..373ef47 100644
--- a/doc/dejagnu.texi
+++ b/doc/dejagnu.texi
@@ -4671,6 +4671,7 @@ tool, and its version number.

@menu
* getdirs Procedure: getdirs procedure
+* relative_filename Procedure: relative_filename procedure
* find Procedure: find procedure
* which Procedure: which procedure
* grep Procedure: grep procedure
@@ -4683,7 +4684,7 @@ tool, and its version number.
* prune_system_crud Procedure: prune_system_crud procedure
@end menu

address@hidden getdirs procedure, find procedure, , Utility Procedures
address@hidden getdirs procedure, relative_filename procedure, Utility 
Procedures, Utility Procedures
@subsubheading getdirs Procedure
@findex getdirs

@@ -4712,7 +4713,26 @@ the pattern. If no directories match the pattern, then 
an empty list is
returned.
@end table

address@hidden find procedure, which procedure, getdirs procedure, Utility 
Procedures
address@hidden relative_filename procedure, find procedure, getdirs procedure, 
Utility Procedures
address@hidden relative_filename Procedure
address@hidden relative_filename
+
+Return a relative file name, given a starting point.
+
address@hidden
address@hidden@b{relative_filename} @i{base} @i{destination}}
address@hidden quotation
+
address@hidden @asis
+
address@hidden @code{base}
+The starting point for relative file name traversal.
+
address@hidden @code{destination}
+The absolute file name that should be reached by appending the return value to 
@i{base}.
address@hidden table
+
address@hidden find procedure, which procedure, relative_filename procedure, 
Utility Procedures
@subsubheading find Procedure
@findex find

@@ -5442,4 +5462,4 @@ This makes runtest exit. It is abbreviated as @emph{q}.

@bye

address@hidden  LocalWords:  subdirectory
address@hidden  LocalWords:  subdirectory prepend prepended testsuite filename
diff --git a/lib/utils.exp b/lib/utils.exp
index 45319f2..0bc759f 100644
--- a/lib/utils.exp
+++ b/lib/utils.exp
@@ -85,6 +85,44 @@ proc getdirs { args } {
}


+# Given a base and a destination, return a relative file name that refers
+# to the destination when used relative to the given base.
+proc relative_filename { base destination } {
+    if { [file pathtype $base] != "absolute" } {
+       set base [file normalize $base]
+    }
+    if { [file pathtype $destination] != "absolute" } {
+       set destination [file normalize $destination]
+    }
+
+    set base [file split $base]
+    set destination [file split $destination]
+
+    verbose "base: \[[llength $base]\] $base" 3
+    verbose "destination: \[[llength $destination]\] $destination" 3
+
+    set basecount [llength $base]
+    for {set i 0} {$i < $basecount
+                  && [lindex $base $i] == [lindex $destination $i]} {incr i} {}
+    if { $i == $basecount } {
+       set tail [lrange $destination $i end]
+    } else {
+       set tail [lrange $destination $i end]
+       while { [incr i] <= $basecount } {
+           set tail [linsert $tail 0 ".."]
+       }
+    }
+
+    if { [llength $tail] == 0 } {
+       set result ""
+    } else {
+       set result [eval file join $tail]
+    }
+    verbose "result: $result" 3
+    return $result
+}
+
+
# Finds paths of all non-directory files, recursively, whose names match
# a pattern.  Certain directory name are not searched (see proc getdirs).
#     rootdir - search in this directory and its subdirectories, recursively.
diff --git a/runtest.exp b/runtest.exp
index b0ddfed..327131a 100644
--- a/runtest.exp
+++ b/runtest.exp
@@ -1771,15 +1771,8 @@ foreach current_target $target_list {
                # set subdir to the tail of the dirname after $srcdir,
                # for the driver files that want it.  XXX this is silly.
                # drivers should get a single var, not "$srcdir/$subdir"
-               set subdir [file dirname $test_name]
-               set p [expr {[string length $srcdir] - 1}]
-               while {0 < $p && [string index $srcdir $p] == "/"} {
-                   incr p -1
-               }
-               if {[string range $subdir 0 $p] == $srcdir} {
-                   set subdir [string range $subdir [expr {$p + 1}] end]
-                   regsub "^/" $subdir "" subdir
-               }
+               set subdir [relative_filename $srcdir \
+                               [file dirname $test_name]]

                # XXX not the right thing to do.
                set runtests [list [file tail $test_name] ""]
@@ -1860,20 +1853,8 @@ foreach current_target $target_list {

                        # Get the path after the $srcdir so we know
                        # the subdir we're in.
-                       set subdir [file dirname $test_name]
-                       # We used to do
-                       # regsub $srcdir [file dirname $test_name] "" subdir
-                       # but what if [file dirname $test_name] contains regexp
-                       # characters? We lose. Instead...
-                       set first [string first $srcdir $subdir]
-                       if { $first >= 0 } {
-                           set first [expr {$first + [string length $srcdir]}]
-                           set subdir [string range $subdir $first end]
-                           regsub "^/" "$subdir" "" subdir
-                       }
-                       if { "$srcdir" == "$subdir" || "$srcdir" == "$subdir/" 
} {
-                           set subdir ""
-                       }
+                       set subdir [relative_filename $srcdir \
+                                       [file dirname $test_name]]
                        # Check to see if the range of tests is limited,
                        # set `runtests' to a list of two elements: the script 
name
                        # and any arguments ("" if none).
diff --git a/testsuite/runtest.all/utils.test b/testsuite/runtest.all/utils.test
index be13982..b8e05da 100644
--- a/testsuite/runtest.all/utils.test
+++ b/testsuite/runtest.all/utils.test
@@ -42,6 +42,29 @@ if [lib_pat_test "getdirs" "${srcdir}/runtest.all/topdir" 
"subdir1*subdir2" ] {
    puts "PASSED: getdirs toplevel, two subdirs"
}

+# Test relative_filename:
+#
+if { [relative_filename "/foo/test" "/foo/test/bar/baz" ] == "bar/baz" } {
+    puts "PASSED: relative_filename, simple prefix"
+} else {
+    puts "FAILED: relative_filename, simple prefix"
+}
+if { [relative_filename "/foo/test" "/bar/test" ] == "../../bar/test" } {
+    puts "PASSED: relative_filename, up to top"
+} else {
+    puts "FAILED: relative_filename, up to top"
+}
+if { [relative_filename "/tmp/foo-test" "/tmp/bar/test" ] == "../bar/test" } {
+    puts "PASSED: relative_filename, up one level"
+} else {
+    puts "FAILED: relative_filename, up one level"
+}
+if { [relative_filename "/tmp/foo-test" "/tmp/foo-test" ] == "" } {
+    puts "PASSED: relative_filename, same name"
+} else {
+    puts "FAILED: relative_filename, same name"
+}
+
# Test find:
#
if [string match "*/subdir2/subfile2" "[find ${srcdir}/runtest.all/topdir/subdir2 
sub*]"] {

----


-- Jacob