# Copyright 2018-2021 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/>.

# Test CLI output styling.

standard_testfile

# Compile the test executable.
set test_macros 0
set options debug
get_compiler_info
if { [test_compiler_info "gcc-*"] } {
    lappend options additional_flags=-g3
    set test_macros 1
} elseif { [test_compiler_info "clang-*"] } {
    lappend options additional_flags=-fdebug-macro
    set test_macros 1
}

if {[build_executable "failed to build" $testfile $srcfile $options]} {
    return -1
}

# The tests in this file are run multiple times with GDB's styles
# disabled one at a time.  This variable is the style that is
# currently disabled.
set currently_disabled_style ""

# A wrapper around the 'style' function found in gdb-utils.exp,
# filter out requests for the disabled style.
proc limited_style { str style } {
    global currently_disabled_style

    if { $style != $currently_disabled_style } {
	return [style $str $style]
    }

    return $str
}

# A wrapper around 'clean_restart' from gdb.exp, this performs the
# normal clean_restart, but then disables the currently disabled
# style.
proc clean_restart_and_disable { args } {
    global currently_disabled_style

    eval "clean_restart $args"

    if { $currently_disabled_style != "" } {
	set st $currently_disabled_style
	gdb_test_no_output "set style $st background none" ""
	gdb_test_no_output "set style $st foreground none" ""
	gdb_test_no_output "set style $st intensity normal" ""
    }
}

# The core of this test script.  Run some tests of different aspects
# of GDB's styling.
#
# Within this proc always use LIMITED_STYLE instead of STYLE, and
# CLEAN_RESTART_AND_DISABLE instead of CLEAN_RESTART, this ensures
# that the test operates as expected as styles are disabled.
proc run_style_tests { } {
    global testfile srcfile hex binfile test_macros
    global currently_disabled_style decimal hex

    save_vars { env(TERM) } {
	# We need an ANSI-capable terminal to get the output.
	setenv TERM ansi

	# Restart GDB with the correct TERM variable setting, this
	# means that GDB will enable styling.
	clean_restart_and_disable ${binfile}

	set readnow [readnow]

	if {![runto_main]} {
	    fail "style tests failed"
	    return
	}

	# Check that the source highlighter has not stripped away the
	# leading newlines.
	set main_line [gdb_get_line_number "break here"]
	gdb_test "list $main_line,$main_line" "return.*some_called_function.*"

	gdb_test_no_output "set style enabled off"

	set argv ""
	gdb_test_multiple "frame" "frame without styling" {
	    -re -wrap "main \\(argc=.*, (argv=$hex)\\).*style\\.c:\[0-9\].*" {
		set argv $expect_out(1,string)
		pass $gdb_test_name
	    }
	}

	gdb_test_no_output "set style enabled on"

	set main_expr [limited_style main function]
	set base_file_expr [limited_style ".*style\\.c" file]
	set file_expr "$base_file_expr:\[0-9\]+"
	set arg_expr [limited_style "arg." variable]

	gdb_test "frame" \
	    [multi_line \
		 "#0\\s+$main_expr\\s+\\($arg_expr=$decimal,\\s+$arg_expr=$hex\\)\\s+at\\s+$file_expr" \
		 "\[0-9\]+\\s+.*return.* break here .*"]
	gdb_test "info breakpoints" "$main_expr at $file_expr.*"

	gdb_test_no_output "set style sources off"
	gdb_test "frame" \
	    "\r\n\[^\033\]*break here.*" \
	    "frame without sources styling"
	gdb_test_no_output "set style sources on"

	gdb_test "break -q main" "file $base_file_expr.*"

	gdb_test "print &main" " = .* [limited_style $hex address] <$main_expr>"

	# Regression test for a bug where line-wrapping would occur at
	# the wrong spot with styling.  There were different bugs at
	# different widths, so try two.
	foreach width {20 30} {
	    set argv_len [string length $argv]
	    if { $argv_len == 0 } {
		continue
	    }

	    # There was also a bug where the styling could be wrong in
	    # the line listing; this is why the words from the source
	    # code are spelled out in the final result line of the
	    # test.
	    set re1_styled \
		[multi_line \
		     "#0\\s+$main_expr\\s+\\($arg_expr=$decimal,\\s+" \
		     "\\s+$arg_expr=$hex\\)" \
		     "\\s+at\\s+$file_expr" \
		     "\[0-9\]+\\s+.*return.* break here .*"]
	    set re2_styled \
		[multi_line \
		     "#0\\s+$main_expr\\s+\\($arg_expr=.*" \
		     "\\s+$arg_expr=$hex\\)\\s+at\\s+$file_expr" \
		     "\[0-9\]+\\s+.*return.* break here .*"]

	    # The length of the line containing argv containing:
	    # - 4 leading spaces
	    # - argv string
	    # - closing parenthesis
	    set line_len [expr 4 + $argv_len + 1]

	    if { $line_len > $width } {
		# At on the next line.
		set re_styled $re1_styled
	    } else {
		# At on the same line as argv.
		set re_styled $re2_styled
	    }

	    gdb_test_no_output "set width $width"
	    gdb_test "frame" $re_styled "frame when width=$width"
	}

	# Reset width back to 0.
	gdb_test_no_output "set width 0" ""

	if {$test_macros} {
	    set macro_line [gdb_get_line_number "\#define SOME_MACRO"]
	    gdb_test "info macro SOME_MACRO" \
		"Defined at $base_file_expr:$macro_line\r\n#define SOME_MACRO 23"
	}

	gdb_test_no_output "set width 0"

	set main [limited_style main function]
	set func [limited_style some_called_function function]
	# Somewhere should see the call to the function.
	gdb_test "disassemble main" \
	    [concat "Dump of assembler code for function $main:.*" \
		 "[limited_style $hex address].*$func.*"]

	set ifield [limited_style int_field variable]
	set sfield [limited_style string_field variable]
	set efield [limited_style e_field variable]
	set evalue [limited_style VALUE_TWO variable]
	gdb_test "print struct_value" \
	    "\{$ifield = 23,.*$sfield = .*,.*$efield = $evalue.*"

	set ffield [limited_style field variable]
	set cstart [string_to_regexp "/* XXX "]
	set cend [string_to_regexp " */"]
	set p1field [limited_style "$cstart.*$decimal.*-bit.*padding.*$cend" \
			 highlight]
	set p2field [limited_style "$cstart.*$decimal.*-byte.*padding.*$cend" \
			 highlight]

	gdb_test "ptype/o just_bitfield_value" \
	    [multi_line \
		 ".* type = struct just_bitfield {" \
		 ".* unsigned int $ffield : 3;" \
		 "$p1field" \
		 "$p2field" \
		 "" \
		 ".* total size.*: *$decimal *$cend" \
		 " *}.*"]

	set address_style_expr [limited_style ".*\".*address.*\".*style.*" address]
	set color "blue"
	if { $currently_disabled_style == "address" } {
	    set color "none"
	}
	gdb_test "show style address foreground" \
	    "The ${address_style_expr} foreground color is: ${color}" \
	    "style name and style word styled using its own style in show style"

	set aliases_expr [limited_style ".*aliases.*" title]
	set breakpoints_expr [limited_style ".*breakpoints.*" title]
	gdb_test "help" \
	    [multi_line \
		 "List of classes of commands:" \
		 "" \
		 "${aliases_expr} -- User-defined aliases of other commands\." \
		 "${breakpoints_expr} -- Making program stop at certain points\." \
		 ".*" \
		] \
	    "help classes of commands styled with title"

	set taas_expr  [limited_style ".*taas.*" title]
	set tfaas_expr  [limited_style ".*tfaas.*" title]
	set cut_for_thre_expr [limited_style "cut for 'thre" highlight]
	gdb_test "apropos -v cut for 'thre" \
	    [multi_line \
		 "" \
		 "${taas_expr}" \
		 "Apply a command to all .*" \
		 "Usage:.*" \
		 "short${cut_for_thre_expr}ad apply.*" \
		 "" \
		 "${tfaas_expr}" \
		 "Apply a command to all .*" \
		 "Usage:.*" \
		 "short${cut_for_thre_expr}ad apply.*" \
		]

	clean_restart_and_disable

	set quoted [string_to_regexp $binfile]
	set pass_re "Reading symbols from [limited_style $quoted file]\.\.\."
	if { $readnow } {
	    set pass_re \
		[multi_line \
		     $pass_re \
		     "Expanding full symbols from [limited_style $quoted file]\.\.\."]
	}
	gdb_test "file $binfile" \
	    $pass_re \
	    "filename is styled when loading symbol file" \
	    "Are you sure you want to change the file.*" \
	    "y"

	gdb_test "pwd" "Working directory [limited_style .*? file].*"

	gdb_test_no_output "set print repeat 3"
	gdb_test "print {0,0,0,0,0,0,0,0}" \
	    " = \\{0 [limited_style {<repeats.*8.*times>} metadata]\\}"

	gdb_test "show logging file" \
	    "The current logfile is \"[limited_style .*? file]\"\\..*"

	# Check warnings are styled by setting a rubbish data
	# directory.
	gdb_test "set data-directory Makefile" \
	    "warning: [limited_style .*? file] is not a directory\\..*"
	gdb_test "show data-directory" \
	    "GDB's data directory is \"[limited_style .*? file]\"\\..*"

	# Check that deprecation styles command names.
	gdb_test_no_output "maintenance deprecate p \"new_p\"" \
	    "maintenance deprecate p \"new_p\" /1/"
	gdb_test "p 5" \
	    "Warning: '[limited_style p title]', an alias for the command '[limited_style print title]', is deprecated.*Use '[limited_style new_p title]'.*" \
	    "p deprecated warning, with replacement"

	# Check that the version string is styled in the output of 'show
	# version', and that this styling can be disabled.
	set vers [style "GNU gdb.*" version]
	gdb_test "show version" "${vers}.*" \
	    "version is styled in 'show version'"
    }
}

# A separate test from the above as the styled text this checks can't
# currently be disabled (the text is printed too early in GDB's
# startup process).
proc test_startup_version_string { } {
    gdb_exit
    gdb_spawn

    # Deliberate use of base STYLE proc here as the style of the
    # startup version string can't (currently) be controlled.
    set vers [style "GNU gdb.*" version]
    gdb_test "" "${vers}.*" "version is styled at startup"
}


# Run tests with all styles in their default state.
with_test_prefix "all styles enabled" {
    run_style_tests
}

# Now, for each style in turn.  Disable that style only and run the
# test again.  Things in that style should NOT now be styled.
foreach style { title file function highlight variable \
		    address metadata } {
    set currently_disabled_style $style
    with_test_prefix "disable style $style" {
	run_style_tests
    }
}

# Finally, check the styling of the version string during startup.
test_startup_version_string