Home | History | Annotate | Line # | Download | only in gdb.fortran
      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