1 1.1.1.2 christos # Copyright 2021-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 # Place a non-dynamic array into an internal variable, then show that 17 1.1 christos # modifications to either the internal variable, or to the original 18 1.1 christos # array are independent. 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 quiet}] } { 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 gdb_breakpoint [gdb_get_line_number "Break here"] 33 1.1 christos gdb_continue_to_breakpoint "Break here" 34 1.1 christos 35 1.1 christos # Take a copy of the array into an internal variable. 36 1.1 christos gdb_test_no_output "set \$a=arr" "set \$a internal variable" 37 1.1 christos 38 1.1 christos # Validate the original contents. 39 1.1 christos gdb_test "print arr" \ 40 1.1 christos " = \\(1, 1, 1, 1, 1, 1, 1, 1, 1, 1\\)" \ 41 1.1 christos "print arr contents" 42 1.1 christos gdb_test "print \$a" \ 43 1.1 christos " = \\(1, 1, 1, 1, 1, 1, 1, 1, 1, 1\\)" \ 44 1.1 christos "print \$a contents" 45 1.1 christos 46 1.1 christos # Modify the original array in memory. 47 1.1 christos gdb_test_no_output "set arr(5) = 5" 48 1.1 christos 49 1.1 christos # Modify the internal variable copy. 50 1.1 christos gdb_test_no_output "set \$a(3) = 3" 51 1.1 christos 52 1.1 christos # Now check that the two values have been updated independently. 53 1.1 christos gdb_test "print arr" \ 54 1.1 christos " = \\(1, 1, 1, 1, 5, 1, 1, 1, 1, 1\\)" \ 55 1.1 christos "print arr contents after change" 56 1.1 christos gdb_test "print \$a" \ 57 1.1 christos " = \\(1, 1, 3, 1, 1, 1, 1, 1, 1, 1\\)" \ 58 1.1 christos "print \$a contents after change" 59