| # Copyright 2015-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/>. |
| |
| standard_testfile ".f90" |
| load_lib "fortran.exp" |
| |
| if {[skip_fortran_tests]} { return -1 } |
| |
| if { [prepare_for_testing "failed to prepare" ${testfile} ${srcfile} \ |
| {debug f90 quiet}] } { |
| return -1 |
| } |
| |
| # check that all fortran standard datatypes will be |
| # handled correctly when using as VLA's |
| |
| if ![fortran_runto_main] { |
| return -1 |
| } |
| |
| # Depending on the compiler being used, the type names can be printed differently. |
| set int [fortran_int4] |
| set real [fortran_real4] |
| set complex [fortran_complex4] |
| set logical [fortran_logical4] |
| |
| gdb_breakpoint [gdb_get_line_number "vlas-allocated"] |
| gdb_continue_to_breakpoint "vlas-allocated" |
| gdb_test "next" " = allocated\\\(realvla\\\)" \ |
| "next to allocation status of intvla" |
| gdb_test "print l" " = \\.TRUE\\." "intvla allocated" |
| gdb_test "next" " = allocated\\\(complexvla\\\)" \ |
| "next to allocation status of realvla" |
| gdb_test "print l" " = \\.TRUE\\." "realvla allocated" |
| gdb_test "next" " = allocated\\\(logicalvla\\\)" \ |
| "next to allocation status of complexvla" |
| gdb_test "print l" " = \\.TRUE\\." "complexvla allocated" |
| gdb_test "next" " = allocated\\\(charactervla\\\)" \ |
| "next to allocation status of logicalvla" |
| gdb_test "print l" " = \\.TRUE\\." "logicalvla allocated" |
| gdb_test "next" "intvla\\\(:,:,:\\\) = 1" \ |
| "next to allocation status of charactervla" |
| gdb_test "print l" " = \\.TRUE\\." "charactervla allocated" |
| |
| gdb_breakpoint [gdb_get_line_number "vlas-initialized"] |
| gdb_continue_to_breakpoint "vlas-initialized" |
| gdb_test "ptype intvla" "type = $int, allocatable \\\(11,22,33\\\)" |
| gdb_test "ptype realvla" "type = $real, allocatable \\\(11,22,33\\\)" |
| gdb_test "ptype complexvla" "type = $complex, allocatable \\\(11,22,33\\\)" |
| gdb_test "ptype logicalvla" "type = $logical, allocatable \\\(11,22,33\\\)" |
| gdb_test "ptype charactervla" "type = character\\\*1, allocatable \\\(11,22,33\\\)" |
| |
| gdb_test "print intvla(5,5,5)" " = 1" "print intvla(5,5,5) (1st)" |
| gdb_test "print realvla(5,5,5)" " = 3.14\\d+" \ |
| "print realvla(5,5,5) (1st)" |
| gdb_test "print complexvla(5,5,5)" " = \\\(2,-3\\\)" \ |
| "print complexvla(5,5,5) (1st)" |
| gdb_test "print logicalvla(5,5,5)" " = \\.TRUE\\." \ |
| "print logicalvla(5,5,5) (1st)" |
| gdb_test "print charactervla(5,5,5)" " = 'K'" \ |
| "print charactervla(5,5,5) (1st)" |
| |
| gdb_breakpoint [gdb_get_line_number "vlas-modified"] |
| gdb_continue_to_breakpoint "vlas-modified" |
| gdb_test "print intvla(5,5,5)" " = 42" "print intvla(5,5,5) (2nd)" |
| gdb_test "print realvla(5,5,5)" " = 4.13\\d+" \ |
| "print realvla(5,5,5) (2nd)" |
| gdb_test "print complexvla(5,5,5)" " = \\\(-3,2\\\)" \ |
| "print complexvla(5,5,5) (2nd)" |
| gdb_test "print logicalvla(5,5,5)" " = \\.FALSE\\." \ |
| "print logicalvla(5,5,5) (2nd)" |
| gdb_test "print charactervla(5,5,5)" " = 'X'" \ |
| "print charactervla(5,5,5) (2nd)" |