| # Copyright 2020-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/> . |
| |
| # Create a slice of an array, then take a slice of that slice. |
| |
| if {[skip_fortran_tests]} { return -1 } |
| |
| standard_testfile ".f90" |
| load_lib fortran.exp |
| |
| if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ |
| {debug f90}]} { |
| return -1 |
| } |
| |
| # Avoid shared lib symbols. |
| gdb_test_no_output "set auto-solib-add off" |
| |
| if ![fortran_runto_main] { |
| return -1 |
| } |
| |
| # Avoid libc symbols, in particular the 'array' type. |
| gdb_test_no_output "nosharedlibrary" |
| |
| # gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"] |
| gdb_breakpoint [gdb_get_line_number "Stop Here"] |
| gdb_breakpoint [gdb_get_line_number "Final Breakpoint"] |
| |
| # We're going to print some reasonably large arrays. |
| gdb_test_no_output "set print elements unlimited" |
| |
| gdb_continue_to_breakpoint "Stop Here" |
| |
| # Print a slice, capture the convenience variable name created. |
| set cmd "print array (1:10:2, 1:10:2)" |
| gdb_test_multiple $cmd $cmd { |
| -re "\r\n\\\$(\\d+) = .*\r\n$gdb_prompt $" { |
| set varname "\$$expect_out(1,string)" |
| } |
| } |
| |
| # Now check that we can correctly extract all the elements from this |
| # slice. |
| for { set j 1 } { $j < 6 } { incr j } { |
| for { set i 1 } { $i < 6 } { incr i } { |
| set val [expr ((($i - 1) * 2) + (($j - 1) * 20)) + 1] |
| gdb_test "print ${varname} ($i,$j)" " = $val" |
| } |
| } |
| |
| # Now take a slice of the slice. |
| gdb_test "print ${varname} (3:5, 3:5)" \ |
| " = \\(\\(45, 47, 49\\) \\(65, 67, 69\\) \\(85, 87, 89\\)\\)" |
| |
| # Now take a different slice of a slice. |
| set cmd "print ${varname} (1:5:2, 1:5:2)" |
| gdb_test_multiple $cmd $cmd { |
| -re "\r\n\\\$(\\d+) = \\(\\(1, 5, 9\\) \\(41, 45, 49\\) \\(81, 85, 89\\)\\)\r\n$gdb_prompt $" { |
| set varname "\$$expect_out(1,string)" |
| pass $gdb_test_name |
| } |
| } |
| |
| # Now take a slice from the slice, of a slice! |
| set cmd "print ${varname} (1:3:2, 1:3:2)" |
| gdb_test_multiple $cmd $cmd { |
| -re "\r\n\\\$(\\d+) = \\(\\(1, 9\\) \\(81, 89\\)\\)\r\n$gdb_prompt $" { |
| set varname "\$$expect_out(1,string)" |
| pass $gdb_test_name |
| } |
| } |
| |
| # And again! |
| set cmd "print ${varname} (1:2:2, 1:2:2)" |
| gdb_test_multiple $cmd $cmd { |
| -re "\r\n\\\$(\\d+) = \\(\\(1\\)\\)\r\n$gdb_prompt $" { |
| set varname "\$$expect_out(1,string)" |
| pass $gdb_test_name |
| } |
| } |
| |
| # Test taking a slice with stride of a string. This isn't actually |
| # supported within gfortran (at least), but naturally drops out of how |
| # GDB models arrays and strings in a similar way, so we may as well |
| # test that this is still working. |
| gdb_test "print str (1:26:2)" " = 'acegikmoqsuwy'" |
| gdb_test "print str (26:1:-1)" " = 'zyxwvutsrqponmlkjihgfedcba'" |
| gdb_test "print str (26:1:-2)" " = 'zxvtrpnljhfdb'" |
| |
| # Now test the memory requirements of taking a slice from an array. |
| # The idea is that we shouldn't require more memory to extract a slice |
| # than the size of the slice. |
| # |
| # This will only work if array repacking is turned on, otherwise GDB |
| # will create the slice by generating a new type that sits over the |
| # existing value in memory. |
| gdb_test_no_output "set fortran repack-array-slices on" |
| set element_size [get_integer_valueof "sizeof (array (1,1))" "unknown"] |
| set slice_size [expr $element_size * 4] |
| gdb_test_no_output "set max-value-size $slice_size" |
| gdb_test "print array (1:2, 1:2)" "= \\(\\(1, 2\\) \\(11, 12\\)\\)" |
| gdb_test "print array (2:3, 2:3)" "= \\(\\(12, 13\\) \\(22, 23\\)\\)" |
| gdb_test "print array (2:5:2, 2:5:2)" "= \\(\\(12, 14\\) \\(32, 34\\)\\)" |