This is the mail archive of the gdb-patches@sourceware.org mailing list for the GDB project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

RE: [RFC] Testsuite: Avoid \r\r\n problem of *-*-mingw* host



> -----Message d'origine-----
> De : gdb-patches-owner@sourceware.org [mailto:gdb-patches-
> owner@sourceware.org] De la part de Doug Evans
> Envoyé : mercredi 18 septembre 2013 09:20
> À : Joel Brobecker
> Cc : Pierre Muller; gdb-patches
> Objet : Re: [RFC] Testsuite: Avoid \r\r\n problem of *-*-mingw* host
> 
> On Tue, Sep 17, 2013 at 7:11 PM, Joel Brobecker <brobecker@adacore.com>
> wrote:
> >>   Here is an alternate proposal to get rid of that double \r
> >> problem encountered when running the testsuite with mingw host GDB.
> >>
> >>   maint set testsuite-mode on
> >> force stdout and stderr to use binary mode.
> >>
> >>   maint set testsuite-mode off
> >> restores stdout and stderr "normal" text mode behavior.
> >
> > FWIW, I tend to think that it's better to test the debugger in
> > an environment that is as close as possible to reality. For
> > those reasons, I tend to favor Yao's approach.  But it's not
> > a strong opinion.
> 
> Can someone explain how \r\r\n occurs?

  As I finally analyzed the problem,
it all comes from the fact that mingw compiled GDB executables
open stdout and stderr in text mode and this generates a \n -> \r\n
translation inside GDB.

> Presumably two difference pieces of software are doing the \n -> \r\n
> translation.
  There is also some \r-> \r\n translation appearing
in normal testsuite on any system.

> What are they?
> 
> [hacking the testsuite may be preferable in some way, but I'm worried
> that road will be long and painful]

  I tried for a while to achieve something reliable...
Here is my last version... Quite ugly and still far from perfect...
This is one of the reasons why I doubt that Yao's patch will work
flawlessly...

  Please do not consider this as a RFC, I only send it here
to show that I tried hard for a while to
do a replacement of \r\n to \r+\n only a the correct locations
in the testuite....





2011-05-24  Pierre Muller  <muller@ics.u-strasbg.fr>

	* testsuite/lib/gdb-textmode.exp: New file.
	* testsuite/lib/gdb.exp (transform_gdb_expect_code): New variable,
	set to adapt_expcode_to_text_mode.
	(gdb_expect): Call $transform_gdb_expect_code if not empty.



Index: src/gdb/testsuite/lib/gdb-textmode.exp
===================================================================
RCS file: testsuite/lib/gdb-textmode.exp
diff -N testsuite/lib/gdb-textmode.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ src/gdb/testsuite/lib/gdb-textmode.exp	24 May 2011 13:19:32 -0000
@@ -0,0 +1,286 @@
+# Copyright 2011
+# Free Software Foundation, Inc.
+
+# 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 3 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, see <http://www.gnu.org/licenses/>.
+
+# This file was written by Pierre Muller. (muller@ics.u-strasbg.fr)
+
+# The main purpose of this file is to implement procedure
+# adapt_expcode_to_text_mode
+# which transforms gdb_expect regular expressions
+# in order to accept two carriage return instead of one.
+
+# This is enabled by default in gdb.exp for mingw djgpp and solaris
+# targets that generate two carriage return instead of one.
+
+global transform_gdb_expect_code
+
+# This variable can be set to zero in site.exp
+# to disable use of text_mode substitution
+
+if { ![info exists use_gdb_textmode] } {
+    global use_gdb_textmode
+    set use_gdb_textmode 1
+}
+
+# Patterns used to delimit regular expressions with expcode
+# These patterns must not appear inside any regular expression used
+# but can be changed here if needed.
+# Change needs an according change to testpattern below.
+set open1 "#A#"
+set open2 "#a#"
+set close1 "#Z#"
+set close2 "#z#"
+# Paranoia check before anything else
+# Needs to be updated if any of the four variables above are changed.
+set testpattern "#\[azAZ\]#"
+
+
+# Several testing procedures and variables.
+trace add variable transform_gdb_expect_code write log_verbose
+
+proc stacktrace {} {
+    set stack "Stack trace:\n"
+    for {set i 1} {$i < [info level]} {incr i} {
+	set lvl [info level -$i]
+	set pname [lindex $lvl 0]
+	append stack [string repeat " " $i]$pname
+	foreach value [lrange $lvl 1 end] arg [info args $pname] {
+	    if {$value eq ""} {
+                info default $pname $arg value
+	    }
+	    append stack " $arg='$value'"
+	}
+	append stack \n
+    }
+    return $stack
+}
+
+global should_debug
+
+if { ! [info exists should_debug] } {
+    set should_debug 0
+}
+
+set store_verbose 0
+
+proc maybe_debug { arg } {
+    global should_debug
+    global verbose
+    global store_verbose
+    if { $should_debug } {
+	exp_internal $arg
+	if { $arg > 0 } {
+	    set store_verbose $verbose
+	    set verbose [expr $verbose + 1]
+	} else {
+	    set verbose $store_verbose
+	}
+    }
+}
+
+
+proc log_verbose { var args } {
+  set name "$var"
+  global $name
+  verbose -log "DEBUG name is $name"
+
+  set value [subst $$name];
+
+  verbose -log "DEBUG transform expect code: $var {$value} $args"
+  set bt [stacktrace]
+  verbose -log "$bt"
+}
+
+# Special code used to transform regular expressions inside
+# gdb_expect to be able to cope with the two \r appearing if
+# stdout is open in text mode.
+# This simply replaces all \r\n by \r+\n, expect if the pattern is within
+# square brackets.
+# FIXME: if expcode contains variables that themselves contain \r\n
+# patterns, those patterns are not correctly converted.
+
+proc adapt_re_expcode_to_text_mode { expcode } {
+    # Phase 1: Protect \\r\\n or \r\n inside squiare brackets
+    # Protect all '\r\n' inside square brackets by
+    # replacing those '\\r\\n' by '\\rzz\\n'
+    verbose "adapt_re_expcode_to_text_mode \"$expcode\"" 2
+ 
+    set subst1a [regsub -all {\[([^]]*)(\\?\\r)(\\?\\n)([^]]*)\]}
"$expcode" \
+		{[\1\2zz\3\4]} expcode1a]
+    if { $subst1a > 0 } {
+	verbose "subst1a $subst1a" 2
+	verbose "before \"$expcode\"" 2
+	verbose "after \"$expcode1a\"" 2
+    }
+    # replacing those '\r\n' by '\rZZ\n'
+    set subst1b [regsub -all {\[([^]]*)\r\n([^]]*)\]} $expcode1a \
+		{[\1\rZZ\n\2]} expcode1]
+    if { $subst1b > 0 } {
+	verbose "subst1b $subst1b" 2
+	verbose "before \"$expcode1a\"" 2
+	verbose "after \"$expcode1\"" 2
+    }
+
+    set subst1 [expr $subst1a + $subst1b];
+    if { $subst1 > 0 } {
+	verbose "expcode1 is \"$expcode1\"" 2
+    }
+
+    # Phase 2a: Replace other \\r\\n by \\r+\\n
+    #exp_internal 1
+    set subst2a [regsub -all {(\\?\\r)(\\?\\n)} $expcode1 {\1+\2}
expcode2a]
+    if { $subst2a > 0 } {
+	verbose "subst2a $subst2a" 2
+	verbose "before \"$expcode1\"" 2
+	verbose "after \"$expcode2a\"" 2
+    }
+    # Phase 2b: Replace other \r\n by \r+\n
+    set subst2b [regsub -all {\r\n} $expcode2a "\r+\n" expcode2]
+    if { $subst2b > 0 } {
+	verbose "subst2b $subst2b" 2
+	verbose "before \"$expcode2a\"" 2
+	verbose "after \"$expcode2\"" 2
+    }
+
+    set subst2 [expr $subst2a + $subst2b];
+
+    # Phase 3a: Convert back \\rzz\\n into \\r\\n inside square brackets
+    set subst3a [regsub -all {\[([^]]*)(\\?\\r)zz(\\?\\n)([^]]*)\]}
$expcode2 \
+		{[\1\2\3\4]} expcode3a]
+    if { $subst3a > 0 } {
+	verbose "subst3a $subst3a" 2
+	verbose "before \"$expcode2\"" 2
+	verbose "after \"$expcode3a\"" 2
+    }
+
+    # Phase 3b: Convert back \rZZ\n into \r\n inside square brackets
+    set subst3b [regsub -all {\[([^]]*)\\rZZ\\n([^]]*)\]} $expcode3a \
+		"\[\\1\r\n\\2\]" expcode3]
+    if { $subst3b > 0 } {
+	verbose "subst3b $subst3b" 2
+	verbose "before \"$expcode3a\"" 2
+	verbose "after \"$expcode3\"" 2
+    }
+
+    set subst3 [expr $subst3a + $subst3b];
+
+    set subst [expr $subst1 + $subst2 + $subst3];
+    if { ($subst1a != $subst3a) || ($subst1b != $subst3b) } {
+	verbose "Problem with substitution expcode3=\"$expcode3\""
+    }
+    if { $subst2 != 0 } {
+	verbose "Special replacement gdb_expect $subst substitutions"
+	verbose "Special replacement in gdb_expect returned
expcode=\"$expcode\""
+    }
+    if { $subst != 0 } {
+	verbose "subst1=$subst1 subst2=$subst2 subst3=$subst3" 3
+    }
+    return $expcode3
+}
+
+proc adapt_expcode_to_text_mode { expcode } {
+    global gdb_prompt
+    global use_gdb_textmode
+    global testpattern
+    global open1 open2
+    global close1 close2
+
+    verbose "Special replacement in gdb_expect entry expcode=\"$expcode\""
4
+    if { $use_gdb_textmode == 0 } {
+	return "$expcode"
+    }
+
+    set paranoia_check [regexp "$testpattern" $expcode" sub0]
+    if {$paranoia_check > 0 } {
+	verbose -log "PROBLEM: pattern $testpattern found in expcode " \
+	    "inside adapt_expcode_to_text_mode"
+    }
+
+    set before1 0
+    set before2 0
+    set substcode "$expcode"
+    set found_match 1
+    while {$found_match > 0} {
+	set sub0 ""
+	set sub1 ""
+	set sub2 ""
+	set sub3 ""
+	set found_match [regexp {^(.*-re *)( \"(?:\\"|[^"])*\" )(.*)$}
$substcode sub0 sub1 sub2 sub3]
+	if { $found_match } {
+	    set sub2s [adapt_re_expcode_to_text_mode $sub2]
+	    set substcodea "$sub1$open1$sub2s$close1$sub3"
+	    verbose  "found_match result=$found_match, sub2=\"$sub2\"" 4
+	    verbose  "sub1=\"$sub1\" sub3=\"$sub3\"" 4
+	    if { ! [string equal "$sub2" "$sub2s" ] } {
+		verbose "sub2 is changed to \"$sub2s\"" 3
+	    }
+	    incr before1 $found_match
+	    set substcode "$substcodea"
+	    verbose "new substcode=\"$substcode\"" 4
+	}
+    }
+    set found_match 1
+    while {$found_match > 0} {
+	set sub0 ""
+	set sub1 ""
+	set sub2 ""
+	set sub3 ""
+	set found_match [regexp {^(.*-re *)( \{(?:[^{}]|\{.*\})*\} )(.*)$}
$substcode sub0 sub1 sub2 sub3]
+	if { $found_match } {
+	    set sub2s [adapt_re_expcode_to_text_mode $sub2]
+	    set substcodea "$sub1$open2$sub2s$close2$sub3"
+	    verbose "found_match result=$found_match, sub2=\"$sub2\"" 4
+	    verbose "sub1=\"$sub1\" sub3=\"$sub3\"" 4
+	    if { ! [string equal "$sub2" "$sub2s" ] } {
+		verbose "sub2 is changed to \"$sub2s\"" 3
+	    }
+	    incr before2 $found_match
+	    set substcode "$substcodea"
+	    verbose "new substcode=\"$substcode\"" 4
+	}
+    }
+    if {$before1 > 0 || $before2 > 0 } {
+      set count [expr $before1 + $before2]
+      verbose "Found $count matches \"$substcode\"" 3
+    } else {
+	verbose -log "No matches found in \"$substcode\"" 4
+    }
+
+    # Remove all delimiters
+    # Use non greedy pattern version with .*?
+    # But add a final call without the question mark, otherwise
+    # one pattern could be missed.
+
+    set after1 [regsub -all "${open1}(.*?)$close1" $substcode {\1}
substcodea]
+    set after2 [regsub -all "${open2}(.*?)$close2" $substcodea {\1}
substcode]
+    set after1b [regsub -all "${open1}(.*)$close1" $substcode {\1}
substcodea]
+    set after2b [regsub -all "${open2}(.*)$close2" $substcodea {\1}
substcode]
+
+    if { $before1 != $after1 + $after1b
+         || $before2 != $after2 + $after2b } {
+	verbose -log "PROBLEM: substitution mismatch"
+	verbose -log "before1=$before1"
+	verbose -log "after1=$after1"
+	verbose -log "after1b=$after1b"
+	verbose -log "before2=$before2"
+	verbose -log "after2=$after2"
+	verbose -log "after2b=$after2b"
+	verbose -log "expcode=\"$substcode\""
+    } else {
+	verbose "expcode=\"$substcode\"" 4
+    }
+    return $substcode
+}
+
Index: src/gdb/testsuite/lib/gdb.exp
===================================================================
RCS file: /cvs/src/src/gdb/testsuite/lib/gdb.exp,v
retrieving revision 1.177
diff -u -p -r1.177 gdb.exp
--- src/gdb/testsuite/lib/gdb.exp	24 May 2011 12:01:22 -0000
1.177
+++ src/gdb/testsuite/lib/gdb.exp	24 May 2011 13:19:33 -0000
@@ -97,6 +97,26 @@ if ![info exists env(EXEEXT)] {
     set EXEEXT $env(EXEEXT)
 }
 
+# Use special procedure adapt_expcode_to_text_mode
+# on targets that tend to emit two '\r' instead of one one
+# as expected in many regular expressions used in gdb_expect calls.
+# The global variable transform_gdb_expect_code
+# has a default empty value, but gets set to
+# the procedure that handles the transformation to support the two '\r'
+# for targets that are in textmode by default or emit two '\r' for
+# other reasons.
+global transform_gdb_expect_code
+set transform_gdb_expect_code ""
+
+# targets that use adapt_expcode_to_text_mode procedure
+# load lib/gdb-textmode.exp file that contains the procedure
implementation.
+if { [istarget "*-*-mingw*"] || [istarget "*djgpp"]
+     || [istarget "*-*-solaris*"] } {
+    load_lib gdb-textmode.exp
+    set transform_gdb_expect_code "adapt_expcode_to_text_mode";
+    verbose "Using adapt_expcode_to_text_mode proc for target"
+}
+
 set octal "\[0-7\]+"
 
 set inferior_exited_re "(\\\[Inferior \[0-9\]+ \\(.*\\) exited)"
@@ -2431,6 +2451,10 @@ proc gdb_expect { args } {
 
     global suppress_flag;
     global remote_suppress_flag;
+    global transform_gdb_expect_code;
+    if { "$transform_gdb_expect_code" != "" } {
+	set expcode [$transform_gdb_expect_code $expcode];
+    }
     if [info exists remote_suppress_flag] {
 	set old_val $remote_suppress_flag;
     }


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]