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

   1 # Copyright 2016 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 standard_testfile ".f90"
  17 load_lib "fortran.exp"
  18
  19 if { [prepare_for_testing "failed to prepare" ${testfile} ${srcfile} \
  20      {debug f90 quiet}] } {
  21     return -1
  22 }
  23
  24 if ![runto_main] {
  25     untested "could not run to main"
  26     return -1
  27 }
  28
  29 # Depending on the compiler being used, the type names can be printed differently.
  30 set int [fortran_int4]
  31
  32 # Check if not allocated VLA in type does not break
  33 # the debugger when accessing it.
  34 gdb_breakpoint [gdb_get_line_number "before-allocated"]
  35 gdb_continue_to_breakpoint "before-allocated"
  36 gdb_test "print twov" " = \\\( ivla1 = <not allocated>, ivla2 = <not allocated> \\\)" \
  37   "print twov before allocated"
  38 gdb_test "print twov%ivla1" " = <not allocated>" \
  39   "print twov%ivla1 before allocated"
  40
  41 # Check type with one VLA's inside
  42 gdb_breakpoint [gdb_get_line_number "onev-filled"]
  43 gdb_continue_to_breakpoint "onev-filled"
  44 gdb_test "print onev%ivla(5, 11, 23)" " = 1"
  45 gdb_test "print onev%ivla(1, 2, 3)" " = 123"
  46 gdb_test "print onev%ivla(3, 2, 1)" " = 321"
  47 gdb_test "ptype onev" \
  48          [multi_line "type = Type one" \
  49                      "\\s+$int :: ivla\\\(11,22,33\\\)" \
  50                      "End Type one" ]
  51
  52 # Check type with two VLA's inside
  53 gdb_breakpoint [gdb_get_line_number "twov-filled"]
  54 gdb_continue_to_breakpoint "twov-filled"
  55 gdb_test "print twov%ivla1(5, 11, 23)" " = 1"
  56 gdb_test "print twov%ivla1(1, 2, 3)" " = 123"
  57 gdb_test "print twov%ivla1(3, 2, 1)" " = 321"
  58 gdb_test "ptype twov" \
  59          [multi_line "type = Type two" \
  60                      "\\s+$int :: ivla1\\\(5,12,99\\\)" \
  61                      "\\s+$int :: ivla2\\\(9,12\\\)" \
  62                      "End Type two" ]
  63 gdb_test "print twov" " = \\\( ivla1 = \\\(\\\( \\\( 1, 1, 1, 1, 1\\\)\
  64  \\\( 1, 1, 321, 1, 1\\\)\
  65  \\\( 1, 1, 1, 1, 1\\\) .*"
  66
  67 # Check type with attribute at beginn of type
  68 gdb_breakpoint [gdb_get_line_number "threev-filled"]
  69 gdb_continue_to_breakpoint "threev-filled"
  70 gdb_test "print threev%ivla(1)" " = 1"
  71 gdb_test "print threev%ivla(5)" " = 42"
  72 gdb_test "print threev%ivla(14)" " = 24"
  73 gdb_test "print threev%ivar" " = 3"
  74 gdb_test "ptype threev" \
  75          [multi_line "type = Type three" \
  76                      "\\s+$int :: ivar" \
  77                      "\\s+$int :: ivla\\\(20\\\)" \
  78                      "End Type three" ]
  79
  80 # Check type with attribute at end of type
  81 gdb_breakpoint [gdb_get_line_number "fourv-filled"]
  82 gdb_continue_to_breakpoint "fourv-filled"
  83 gdb_test "print fourv%ivla(1)" " = 1"
  84 gdb_test "print fourv%ivla(2)" " = 2"
  85 gdb_test "print fourv%ivla(7)" " = 7"
  86 gdb_test "print fourv%ivla(12)" "no such vector element"
  87 gdb_test "print fourv%ivar" " = 3"
  88 gdb_test "ptype fourv" \
  89          [multi_line "type = Type four" \
  90                      "\\s+$int :: ivla\\\(10\\\)" \
  91                      "\\s+$int :: ivar" \
  92                      "End Type four" ]
  93
  94 # Check nested types containing a VLA
  95 gdb_breakpoint [gdb_get_line_number "fivev-filled"]
  96 gdb_continue_to_breakpoint "fivev-filled"
  97 gdb_test "print fivev%tone%ivla(5, 5, 1)" " = 1"
  98 gdb_test "print fivev%tone%ivla(1, 2, 3)" " = 123"
  99 gdb_test "print fivev%tone%ivla(3, 2, 1)" " = 321"
 100 gdb_test "ptype fivev" \
 101          [multi_line "type = Type five" \
 102                      "\\s+Type one :: tone" \
 103                      "End Type five" ]
 104 gdb_test "ptype fivev%tone" \
 105          [multi_line "type = Type one" \
 106                      "    $int :: ivla\\(10,10,10\\)" \
 107                      "End Type one" ]
 108
 109 # Check array of types containing a VLA
 110 gdb_breakpoint [gdb_get_line_number "fivearr-filled"]
 111 gdb_continue_to_breakpoint "fivearr-filled"
 112 gdb_test "print fivearr(1)%tone%ivla(1, 2, 3)" " = 1"
 113 gdb_test "print fivearr(1)%tone%ivla(2, 2, 10)" "no such vector element"
 114 gdb_test "print fivearr(1)%tone%ivla(2, 2, 3)" " = 223"
 115 gdb_test "print fivearr(2)%tone%ivla(12, 14, 16)" " = 2"
 116 gdb_test "print fivearr(2)%tone%ivla(6, 7, 8)" " = 678"
 117 gdb_test "ptype fivearr(1)" \
 118          [multi_line "type = Type five" \
 119                      "\\s+Type one :: tone" \
 120                      "End Type five" ]
 121 gdb_test "ptype fivearr(1)%tone" \
 122          [multi_line "type = Type one" \
 123                      "    $int :: ivla\\(2,4,6\\)" \
 124                      "End Type one" ]
 125 gdb_test "ptype fivearr(2)" \
 126          [multi_line "type = Type five" \
 127                      "\\s+Type one :: tone" \
 128                      "End Type five" ]
 129 gdb_test "ptype fivearr(2)%tone" \
 130          [multi_line "type = Type one" \
 131                      "    $int :: ivla\\(12,14,16\\)" \
 132                      "End Type one" ]
 133
 134 # Check allocation status of dynamic array and it's dynamic members
 135 gdb_test "ptype fivedynarr" "type = <not allocated>"
 136 gdb_test "next" ""
 137 gdb_test "ptype fivedynarr(2)" \
 138          [multi_line "type = Type five" \
 139                      "\\s+Type one :: tone" \
 140                      "End Type five" ] \
 141          "ptype fivedynarr(2), tone is not allocated"
 142 gdb_test "ptype fivedynarr(2)%tone" \
 143          [multi_line "type = Type one" \
 144                      "    $int :: ivla\\(<not allocated>\\)" \
 145                      "End Type one" ] \
 146          "ptype fivedynarr(2)%tone, not allocated"
 147
 148 # Check dynamic array of types containing a VLA
 149 gdb_breakpoint [gdb_get_line_number "fivedynarr-filled"]
 150 gdb_continue_to_breakpoint "fivedynarr-filled"
 151 gdb_test "print fivedynarr(1)%tone%ivla(1, 2, 3)" " = 1"
 152 gdb_test "print fivedynarr(1)%tone%ivla(2, 2, 10)" "no such vector element"
 153 gdb_test "print fivedynarr(1)%tone%ivla(2, 2, 3)" " = 223"
 154 gdb_test "print fivedynarr(2)%tone%ivla(12, 14, 16)" " = 2"
 155 gdb_test "print fivedynarr(2)%tone%ivla(6, 7, 8)" " = 678"
 156 gdb_test "ptype fivedynarr(1)" \
 157          [multi_line "type = Type five" \
 158                      "\\s+Type one :: tone" \
 159                      "End Type five" ]
 160 gdb_test "ptype fivedynarr(1)%tone" \
 161          [multi_line "type = Type one" \
 162                      "    $int :: ivla\\(2,4,6\\)" \
 163                      "End Type one" ]
 164 gdb_test "ptype fivedynarr(2)" \
 165          [multi_line "type = Type five" \
 166                      "\\s+Type one :: tone" \
 167                      "End Type five" ]
 168 gdb_test "ptype fivedynarr(2)%tone" \
 169          [multi_line "type = Type one" \
 170                      "    $int :: ivla\\(12,14,16\\)" \
 171                      "End Type one" ]