1# Copyright 2019-2020 Free Software Foundation, Inc. 2# 3# This program is free software; you can redistribute it and/or modify 4# it under the terms of the GNU General Public License as published by 5# the Free Software Foundation; either version 3 of the License, or 6# (at your option) any later version. 7# 8# This program is distributed in the hope that it will be useful, 9# but WITHOUT ANY WARRANTY; without even the implied warranty of 10# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11# GNU General Public License for more details. 12# 13# You should have received a copy of the GNU General Public License 14# along with this program. If not, see <http://www.gnu.org/licenses/>. 15 16# Check how GDB handles printing pointers, both when associated, and 17# when not associated. 18 19standard_testfile "pointers.f90" 20load_lib fortran.exp 21 22if {[skip_fortran_tests]} { return -1 } 23 24if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ 25 {debug f90 quiet}] } { 26 return -1 27} 28 29if ![fortran_runto_main] { 30 untested "could not run to main" 31 return -1 32} 33 34# Depending on the compiler being used, the type names can be printed 35# differently. 36set logical [fortran_logical4] 37set real [fortran_real4] 38set int [fortran_int4] 39set complex [fortran_complex4] 40 41# Print the inferior variable VAR_NAME, and check that the result 42# matches the string TYPE. 43proc check_pointer_type { var_name type } { 44 gdb_test "ptype ${var_name}" \ 45 "type = PTR TO -> \\( ${type} \\)" 46} 47 48gdb_breakpoint [gdb_get_line_number "Before pointer assignment"] 49gdb_continue_to_breakpoint "Before pointer assignment" 50 51with_test_prefix "pointers not associated" { 52 check_pointer_type "logp" "$logical" 53 check_pointer_type "comp" "$complex" 54 check_pointer_type "charp" "character\\*1" 55 check_pointer_type "charap" "character\\*3" 56 check_pointer_type "intp" "$int" 57 58 # Current gfortran seems to not mark 'intap' as a pointer. Intels 59 # Fortran compiler does though. 60 set test "ptype intap" 61 gdb_test_multiple "ptype intap" $test { 62 -re "type = PTR TO -> \\( $int \\(:,:\\) \\)\r\n$gdb_prompt $" { 63 pass $test 64 } 65 -re "type = $int \\(:,:\\)\r\n$gdb_prompt $" { 66 pass $test 67 } 68 } 69 70 check_pointer_type "realp" "$real" 71 check_pointer_type "twop" \ 72 [multi_line "Type two" \ 73 " $int, allocatable :: ivla1\\(:\\)" \ 74 " $int, allocatable :: ivla2\\(:,:\\)" \ 75 "End Type two"] 76} 77 78gdb_test "ptype two" \ 79 [multi_line "type = Type two" \ 80 " $int, allocatable :: ivla1\\(:\\)" \ 81 " $int, allocatable :: ivla2\\(:,:\\)" \ 82 "End Type two"] 83 84gdb_breakpoint [gdb_get_line_number "Before value assignment"] 85gdb_continue_to_breakpoint "Before value assignment" 86gdb_test "ptype twop" \ 87 [multi_line "type = PTR TO -> \\( Type two" \ 88 " $int, allocatable :: ivla1\\(:\\)" \ 89 " $int, allocatable :: ivla2\\(:,:\\)" \ 90 "End Type two \\)"] 91 92gdb_breakpoint [gdb_get_line_number "After value assignment"] 93gdb_continue_to_breakpoint "After value assignment" 94gdb_test "ptype logv" "type = $logical" 95gdb_test "ptype comv" "type = $complex" 96gdb_test "ptype charv" "type = character\\*1" 97gdb_test "ptype chara" "type = character\\*3" 98gdb_test "ptype intv" "type = $int" 99gdb_test "ptype inta" "type = $int \\(10,2\\)" 100gdb_test "ptype realv" "type = $real" 101 102gdb_test "ptype logp" "type = PTR TO -> \\( $logical \\)" 103gdb_test "ptype comp" "type = PTR TO -> \\( $complex \\)" 104gdb_test "ptype charp" "type = PTR TO -> \\( character\\*1 \\)" 105gdb_test "ptype charap" "type = PTR TO -> \\( character\\*3 \\)" 106gdb_test "ptype intp" "type = PTR TO -> \\( $int \\)" 107set test "ptype intap" 108gdb_test_multiple $test $test { 109 -re "type = $int \\(10,2\\)\r\n$gdb_prompt $" { 110 pass $test 111 } 112 -re "type = PTR TO -> \\( $int \\(10,2\\)\\)\r\n$gdb_prompt $" { 113 pass $test 114 } 115} 116gdb_test "ptype realp" "type = PTR TO -> \\( $real \\)" 117