gdb/testsuite/gdb.mi/mi-vla-fortran.exp

   1 # Copyright 2015-2021 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 # Verify that, using the MI, we can evaluate a simple Fortran Variable
  17 # Length Array (VLA).
  18
  19 if { [skip_fortran_tests] } { return -1 }
  20
  21 load_lib mi-support.exp
  22 load_lib fortran.exp
  23 set MIFLAGS "-i=mi"
  24
  25 gdb_exit
  26 if [mi_gdb_start] {
  27     continue
  28 }
  29
  30 standard_testfile vla.f90
  31
  32 if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable \
  33      {debug f90}] != "" } {
  34      untested "failed to compile"
  35      return -1
  36 }
  37
  38 # Depending on the compiler being used,
  39 # the type names can be printed differently.
  40 set real [fortran_real4]
  41
  42 mi_delete_breakpoints
  43 mi_gdb_reinitialize_dir $srcdir/$subdir
  44 mi_gdb_load ${binfile}
  45
  46 set bp_lineno [gdb_get_line_number "vla1-not-allocated"]
  47 mi_create_breakpoint "-t vla.f90:$bp_lineno" \
  48     "insert breakpoint at line $bp_lineno (vla not allocated)" \
  49     -number 1 -disp del -func vla ".*vla.f90" $bp_lineno $hex
  50 mi_run_cmd
  51 mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
  52   { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
  53 mi_gdb_test "500-data-evaluate-expression vla1" \
  54   "500\\^done,value=\"<not allocated>\"" "evaluate not allocated vla, before allocation"
  55
  56 mi_create_varobj_checked vla1_not_allocated vla1 "$real, allocatable \\(:\\)" \
  57   "create local variable vla1_not_allocated"
  58 mi_gdb_test "501-var-info-type vla1_not_allocated" \
  59   "501\\^done,type=\"$real, allocatable \\(:\\)\"" \
  60   "info type variable vla1_not_allocated"
  61 mi_gdb_test "502-var-show-format vla1_not_allocated" \
  62   "502\\^done,format=\"natural\"" \
  63   "show format variable vla1_not_allocated"
  64 mi_gdb_test "503-var-evaluate-expression vla1_not_allocated" \
  65   "503\\^done,value=\"\\\[0\\\]\"" \
  66   "eval variable vla1_not_allocated"
  67 mi_list_array_varobj_children_with_index "vla1_not_allocated" "0" "1" \
  68     "$real" "get children of vla1_not_allocated"
  69
  70
  71
  72 set bp_lineno [gdb_get_line_number "vla1-allocated"]
  73 mi_create_breakpoint "-t vla.f90:$bp_lineno" \
  74     "insert breakpoint at line $bp_lineno (vla allocated)" \
  75     -number 2 -disp del -func vla ".*vla.f90" $bp_lineno $hex
  76 mi_run_cmd
  77 mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
  78   { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
  79 mi_gdb_test "510-data-evaluate-expression vla1" \
  80   "510\\^done,value=\"\\(.*\\)\"" "evaluate allocated vla"
  81
  82 mi_create_varobj_checked vla1_allocated vla1 "$real, allocatable \\\(5\\\)" \
  83   "create local variable vla1_allocated"
  84 mi_gdb_test "511-var-info-type vla1_allocated" \
  85   "511\\^done,type=\"$real, allocatable \\\(5\\\)\"" \
  86   "info type variable vla1_allocated"
  87 mi_gdb_test "512-var-show-format vla1_allocated" \
  88   "512\\^done,format=\"natural\"" \
  89   "show format variable vla1_allocated"
  90 mi_gdb_test "513-var-evaluate-expression vla1_allocated" \
  91   "513\\^done,value=\"\\\[5\\\]\"" \
  92   "eval variable vla1_allocated"
  93 mi_list_array_varobj_children_with_index "vla1_allocated" "5" "1" \
  94     "$real" "get children of vla1_allocated"
  95
  96
  97 set bp_lineno [gdb_get_line_number "vla1-filled"]
  98 mi_create_breakpoint "-t vla.f90:$bp_lineno" \
  99     "insert breakpoint at line $bp_lineno" \
 100     -number 3 -disp del -func vla ".*vla.f90" $bp_lineno $hex
 101 mi_run_cmd
 102 mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
 103   { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
 104 mi_gdb_test "520-data-evaluate-expression vla1" \
 105   "520\\^done,value=\"\\(1, 1, 1, 1, 1\\)\"" "evaluate filled vla, filled all 1s"
 106
 107
 108 set bp_lineno [gdb_get_line_number "vla1-modified"]
 109 mi_create_breakpoint "-t vla.f90:$bp_lineno" \
 110     "insert breakpoint at line $bp_lineno" \
 111     -number 4 -disp del -func vla ".*vla.f90" $bp_lineno $hex
 112 mi_run_cmd
 113 mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
 114   { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
 115 mi_gdb_test "530-data-evaluate-expression vla1" \
 116   "530\\^done,value=\"\\(1, 42, 1, 24, 1\\)\"" "evaluate filled vla, contents modified"
 117 mi_gdb_test "540-data-evaluate-expression vla1(1)" \
 118   "540\\^done,value=\"1\"" "evaluate filled vla(1)"
 119 mi_gdb_test "550-data-evaluate-expression vla1(2)" \
 120   "550\\^done,value=\"42\"" "evaluate filled vla(2)"
 121 mi_gdb_test "560-data-evaluate-expression vla1(4)" \
 122   "560\\^done,value=\"24\"" "evaluate filled vla(4)"
 123
 124
 125 set bp_lineno [gdb_get_line_number "vla1-deallocated"]
 126 mi_create_breakpoint "-t vla.f90:$bp_lineno" \
 127     "insert breakpoint at line $bp_lineno" \
 128     -number 5 -disp del -func vla ".*vla.f90" $bp_lineno $hex
 129 mi_run_cmd
 130 mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
 131   { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
 132 mi_gdb_test "570-data-evaluate-expression vla1" \
 133   "570\\^done,value=\"<not allocated>\"" "evaluate not allocated vla, after deallocation"
 134
 135
 136 set bp_lineno [gdb_get_line_number "pvla2-not-associated"]
 137 mi_create_breakpoint "-t vla.f90:$bp_lineno" \
 138     "insert breakpoint at line $bp_lineno" \
 139     -number 6 -disp "del" -func "vla" ".*vla.f90" $bp_lineno $hex
 140 mi_run_cmd
 141 mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
 142   { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
 143
 144
 145 set test "evaluate not associated vla"
 146 send_gdb "580-data-evaluate-expression pvla2\n"
 147 gdb_expect {
 148     -re "580\\^done,value=\"<not associated>\".*${mi_gdb_prompt}$" {
 149         pass $test
 150
 151         mi_create_varobj_checked pvla2_not_associated pvla2 "$real \\(:,:\\)" \
 152             "create local variable pvla2_not_associated"
 153         mi_gdb_test "581-var-info-type pvla2_not_associated" \
 154             "581\\^done,type=\"$real \\(:,:\\)\"" \
 155             "info type variable pvla2_not_associated"
 156         mi_gdb_test "582-var-show-format pvla2_not_associated" \
 157             "582\\^done,format=\"natural\"" \
 158             "show format variable pvla2_not_associated"
 159         mi_gdb_test "583-var-evaluate-expression pvla2_not_associated" \
 160             "583\\^done,value=\"\\\[0\\\]\"" \
 161             "eval variable pvla2_not_associated"
 162         mi_list_array_varobj_children_with_index "pvla2_not_associated" "0" "1" \
 163             "$real" "get children of pvla2_not_associated"
 164     }
 165     -re "580\\^error,msg=\"value contents too large \\(\[0-9\]+ bytes\\).*${mi_gdb_prompt}$" {
 166         # Undefined behaviour in gfortran.
 167         xfail $test
 168     }
 169     -re "${mi_gdb_prompt}$" {
 170         fail $test
 171     }
 172     timeout {
 173         fail "$test (timeout)"
 174     }
 175 }
 176
 177 set bp_lineno [gdb_get_line_number "pvla2-associated"]
 178 mi_create_breakpoint "-t vla.f90:$bp_lineno" \
 179     "insert breakpoint at line $bp_lineno" \
 180     -number 7 -disp del -func vla ".*vla.f90" $bp_lineno $hex
 181 mi_run_cmd
 182 mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
 183   { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
 184 mi_gdb_test "590-data-evaluate-expression pvla2" \
 185   "590\\^done,value=\"\\(\\(2, 2, 2, 2, 2\\) \\(2, 2, 2, 2, 2\\)\\)\"" \
 186   "evaluate associated vla"
 187
 188 mi_create_varobj_checked pvla2_associated pvla2 \
 189   "$real \\\(5,2\\\)" "create local variable pvla2_associated"
 190 mi_gdb_test "591-var-info-type pvla2_associated" \
 191   "591\\^done,type=\"$real \\\(5,2\\\)\"" \
 192   "info type variable pvla2_associated"
 193 mi_gdb_test "592-var-show-format pvla2_associated" \
 194   "592\\^done,format=\"natural\"" \
 195   "show format variable pvla2_associated"
 196 mi_gdb_test "593-var-evaluate-expression pvla2_associated" \
 197   "593\\^done,value=\"\\\[2\\\]\"" \
 198   "eval variable pvla2_associated"
 199
 200
 201 set bp_lineno [gdb_get_line_number "pvla2-set-to-null"]
 202 mi_create_breakpoint "-t vla.f90:$bp_lineno" \
 203     "insert breakpoint at line $bp_lineno" \
 204     -number 8 -disp del -func vla ".*vla.f90" $bp_lineno $hex
 205 mi_run_cmd
 206 mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
 207   { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
 208 mi_gdb_test "600-data-evaluate-expression pvla2" \
 209   "600\\^done,value=\"<not associated>\"" "evaluate vla pointer set to null"
 210
 211 mi_gdb_exit
 212 return 0