gdb: Better support for dynamic properties with negative values

[deliverable/binutils-gdb.git] / gdb / testsuite / gdb.fortran / derived-type.exp

diff --git a/gdb/testsuite/gdb.fortran/derived-type.exp b/gdb/testsuite/gdb.fortran/derived-type.exp
index a5f97ac7e52774a6b9f9e90172dcf8c4896049c0..8c2e15199ab1984d3a0ee0a790456e2a6fb30b60 100644 (file)
--- a/gdb/testsuite/gdb.fortran/derived-type.exp
+++ b/gdb/testsuite/gdb.fortran/derived-type.exp
@@ -1,4 +1,4 @@
-# Copyright 2005, 2007, 2008 Free Software Foundation, Inc.
+# Copyright 2005-2019 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
@@ -18,47 +18,100 @@
 # This file is part of the gdb testsuite.  It contains tests for type-printing
 # and value-printing Fortran derived types.
 
-if $tracelevel then {
-       strace $tracelevel
-}
+if { [skip_fortran_tests] } { return -1 }
 
-set testfile "derived-type"
-set srcfile ${testfile}.f90
-set binfile ${objdir}/${subdir}/${testfile}
+standard_testfile .f90
+load_lib "fortran.exp"
 
-if  { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug f77 quiet}] != "" } {
-    untested "Couldn't compile ${srcfile}"
+if {[prepare_for_testing "failed to prepare" $testfile $srcfile {debug f90}]} {
     return -1
 }
 
-gdb_exit
-gdb_start
-gdb_reinitialize_dir $srcdir/$subdir
-gdb_load ${binfile}
-
 if ![runto MAIN__] then {
     perror "couldn't run to breakpoint MAIN__"
     continue
 }
 
-gdb_test "ptype p" \
-    "type = Type bar.*int4.*\:\: c.*real.*\:\: d.*End Type bar" \
-    "ptype p"
-gdb_test "ptype q" \
-    "type = Type foo.*real.*\:\: a.*Type bar.*int4.*\:\: c.*real.*\:\: d.*End Type bar \:\: x.*character.*\\(7\\) \:\: b.*End Type foo" \
-    "type-printing for derived type"
+# Depending on the compiler being used, the type names can be printed differently.
+set int [fortran_int4]
+set real [fortran_real4]
+
+gdb_test "ptype p" "type = Type bar\r\n *$int :: c\r\n *$real :: d\r\n *End Type bar"
+
+set test "type-printing for derived type"
+gdb_test_multiple "ptype q" $test {
+    -re "type = Type foo\r\n *$real :: a\r\n *Type bar :: x\r\n *character\\*7 :: b\r\n *End Type foo\r\n$gdb_prompt $" {
+       pass $test
+    }
+    -re "type = Type foo\r\n *$real :: a\r\n *Type bar :: x\r\n *character :: b\\(7\\)\r\n *End Type foo\r\n$gdb_prompt $" {
+       # Compiler should produce string, not an array of characters.
+       setup_xfail "*-*-*"
+       fail $test
+    }
+}
 
 gdb_breakpoint [gdb_get_line_number "print"]
 gdb_continue_to_breakpoint "print"
 
-gdb_test "print p" "\\$\[0-9\]+ = \\{ 1, 2.375\\}"
+gdb_test "print p" "\\$\[0-9\]+ = \\( c = 1, d = 2\\.375 \\)"
 gdb_test "print p%c" "\\$\[0-9\]+ = 1"
-gdb_test "print p%d" "\\$\[0-9\]+ = 2.375"
-gdb_test "print q%a" "\\$\[0-9\]+ = 3.125"
-gdb_test "print q%b" "\\$\[0-9\]+ = \\(.*a.*b.*c.*d.*e.*f.*g.*\\)"
+gdb_test "print p%d" "\\$\[0-9\]+ = 2\\.375"
+gdb_test "print q%a" "\\$\[0-9\]+ = 3\\.125"
+
+set test "print q%b"
+gdb_test_multiple $test $test {
+    -re "\\$\[0-9\]+ = 'abcdefg'\r\n$gdb_prompt $" {
+       pass $test
+    }
+    -re "\\$\[0-9\]+ = \\(97 'a', 98 'b', 99 'c', 100 'd', 101 'e', 102 'f', 103 'g'\\)\r\n$gdb_prompt $" {
+       # Compiler should produce string, not an array of characters.
+       setup_xfail "*-*-*"
+       fail $test
+    }
+}
+
 gdb_test "print q%x%c" "\\$\[0-9\]+ = 1"
-gdb_test "print q%x%d" "\\$\[0-9\]+ = 2.375"
-gdb_test "print q" \
-    "\\$\[0-9\]+ = \\{ 3.125, \\{ 1, 2.375\\}, \\(.*a.*b.*c.*d.*e.*f.*g.*\\)\\}" \
-    "print q"
+gdb_test "print q%x%d" "\\$\[0-9\]+ = 2\\.375"
 
+set result_line "= \\( a = 3.125, x = \\( c = 1, d = 2\\.375 \\),\
+b = 'abcdefg' \\)\r\n$gdb_prompt $"
+
+# Used in case compiler generates an array of characters.
+set result_line_2 " = \\( a = 3.125, x = \\( 1, 2\\.375 \\),\
+b = \\('abcdefg'\\) \\)\r\n$gdb_prompt $"
+
+set test "print q"
+gdb_test_multiple $test $test {
+    -re $result_line {
+       pass $test
+    }
+    -re $result_line_2 {
+       # Compiler should produce string, not an array of characters.
+       setup_xfail "*-*-*"
+       fail $test
+    }
+}
+
+gdb_test "print this%a" " = 3\\.125"
+
+set test "print this%b"
+gdb_test_multiple $test $test {
+    -re " = 'abcdefg'\r\n$gdb_prompt $" {
+        pass $test
+    }
+    -re $result_line_2 {
+        setup_xfail "*-*-*"
+        fail $test
+    }
+}
+
+set test "print this"
+gdb_test_multiple $test $test {
+    -re $result_line {
+        pass $test
+    }
+    -re $result_line_2 {
+         setup_xfail "*-*-*"
+         fail $test
+    }
+}