1 1.1.1.2 christos # Copyright 2020-2024 Free Software Foundation, Inc. 2 1.1 christos 3 1.1 christos # This program is free software; you can redistribute it and/or modify 4 1.1 christos # it under the terms of the GNU General Public License as published by 5 1.1 christos # the Free Software Foundation; either version 3 of the License, or 6 1.1 christos # (at your option) any later version. 7 1.1 christos # 8 1.1 christos # This program is distributed in the hope that it will be useful, 9 1.1 christos # but WITHOUT ANY WARRANTY; without even the implied warranty of 10 1.1 christos # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 1.1 christos # GNU General Public License for more details. 12 1.1 christos # 13 1.1 christos # You should have received a copy of the GNU General Public License 14 1.1 christos # along with this program. If not, see <http://www.gnu.org/licenses/> . 15 1.1 christos 16 1.1 christos # Create a slice of an array, then take a slice of that slice. 17 1.1 christos 18 1.1.1.2 christos require allow_fortran_tests 19 1.1 christos 20 1.1 christos standard_testfile ".f90" 21 1.1 christos load_lib fortran.exp 22 1.1 christos 23 1.1 christos if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ 24 1.1 christos {debug f90}]} { 25 1.1 christos return -1 26 1.1 christos } 27 1.1 christos 28 1.1 christos if ![fortran_runto_main] { 29 1.1 christos return -1 30 1.1 christos } 31 1.1 christos 32 1.1 christos # Avoid libc symbols, in particular the 'array' type. 33 1.1 christos gdb_test_no_output "nosharedlibrary" 34 1.1 christos 35 1.1 christos # gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"] 36 1.1 christos gdb_breakpoint [gdb_get_line_number "Stop Here"] 37 1.1 christos gdb_breakpoint [gdb_get_line_number "Final Breakpoint"] 38 1.1 christos 39 1.1 christos # We're going to print some reasonably large arrays. 40 1.1 christos gdb_test_no_output "set print elements unlimited" 41 1.1 christos 42 1.1 christos gdb_continue_to_breakpoint "Stop Here" 43 1.1 christos 44 1.1 christos # Print a slice, capture the convenience variable name created. 45 1.1 christos set cmd "print array (1:10:2, 1:10:2)" 46 1.1 christos gdb_test_multiple $cmd $cmd { 47 1.1 christos -re "\r\n\\\$(\\d+) = .*\r\n$gdb_prompt $" { 48 1.1 christos set varname "\$$expect_out(1,string)" 49 1.1 christos } 50 1.1 christos } 51 1.1 christos 52 1.1 christos # Now check that we can correctly extract all the elements from this 53 1.1 christos # slice. 54 1.1 christos for { set j 1 } { $j < 6 } { incr j } { 55 1.1 christos for { set i 1 } { $i < 6 } { incr i } { 56 1.1 christos set val [expr ((($i - 1) * 2) + (($j - 1) * 20)) + 1] 57 1.1 christos gdb_test "print ${varname} ($i,$j)" " = $val" 58 1.1 christos } 59 1.1 christos } 60 1.1 christos 61 1.1 christos # Now take a slice of the slice. 62 1.1 christos gdb_test "print ${varname} (3:5, 3:5)" \ 63 1.1 christos " = \\(\\(45, 47, 49\\) \\(65, 67, 69\\) \\(85, 87, 89\\)\\)" 64 1.1 christos 65 1.1 christos # Now take a different slice of a slice. 66 1.1 christos set cmd "print ${varname} (1:5:2, 1:5:2)" 67 1.1 christos gdb_test_multiple $cmd $cmd { 68 1.1 christos -re "\r\n\\\$(\\d+) = \\(\\(1, 5, 9\\) \\(41, 45, 49\\) \\(81, 85, 89\\)\\)\r\n$gdb_prompt $" { 69 1.1 christos set varname "\$$expect_out(1,string)" 70 1.1 christos pass $gdb_test_name 71 1.1 christos } 72 1.1 christos } 73 1.1 christos 74 1.1 christos # Now take a slice from the slice, of a slice! 75 1.1 christos set cmd "print ${varname} (1:3:2, 1:3:2)" 76 1.1 christos gdb_test_multiple $cmd $cmd { 77 1.1 christos -re "\r\n\\\$(\\d+) = \\(\\(1, 9\\) \\(81, 89\\)\\)\r\n$gdb_prompt $" { 78 1.1 christos set varname "\$$expect_out(1,string)" 79 1.1 christos pass $gdb_test_name 80 1.1 christos } 81 1.1 christos } 82 1.1 christos 83 1.1 christos # And again! 84 1.1 christos set cmd "print ${varname} (1:2:2, 1:2:2)" 85 1.1 christos gdb_test_multiple $cmd $cmd { 86 1.1 christos -re "\r\n\\\$(\\d+) = \\(\\(1\\)\\)\r\n$gdb_prompt $" { 87 1.1 christos set varname "\$$expect_out(1,string)" 88 1.1 christos pass $gdb_test_name 89 1.1 christos } 90 1.1 christos } 91 1.1 christos 92 1.1 christos # Test taking a slice with stride of a string. This isn't actually 93 1.1 christos # supported within gfortran (at least), but naturally drops out of how 94 1.1 christos # GDB models arrays and strings in a similar way, so we may as well 95 1.1 christos # test that this is still working. 96 1.1 christos gdb_test "print str (1:26:2)" " = 'acegikmoqsuwy'" 97 1.1 christos gdb_test "print str (26:1:-1)" " = 'zyxwvutsrqponmlkjihgfedcba'" 98 1.1 christos gdb_test "print str (26:1:-2)" " = 'zxvtrpnljhfdb'" 99 1.1 christos 100 1.1 christos # Now test the memory requirements of taking a slice from an array. 101 1.1 christos # The idea is that we shouldn't require more memory to extract a slice 102 1.1 christos # than the size of the slice. 103 1.1 christos # 104 1.1 christos # This will only work if array repacking is turned on, otherwise GDB 105 1.1 christos # will create the slice by generating a new type that sits over the 106 1.1 christos # existing value in memory. 107 1.1 christos gdb_test_no_output "set fortran repack-array-slices on" 108 1.1 christos set element_size [get_integer_valueof "sizeof (array (1,1))" "unknown"] 109 1.1 christos set slice_size [expr $element_size * 4] 110 1.1 christos gdb_test_no_output "set max-value-size $slice_size" 111 1.1 christos gdb_test "print array (1:2, 1:2)" "= \\(\\(1, 2\\) \\(11, 12\\)\\)" 112 1.1 christos gdb_test "print array (2:3, 2:3)" "= \\(\\(12, 13\\) \\(22, 23\\)\\)" 113 1.1 christos gdb_test "print array (2:5:2, 2:5:2)" "= \\(\\(12, 14\\) \\(32, 34\\)\\)" 114