[thirdparty/binutils-gdb.git] / gdb / testsuite / gdb.mi / mi-vla-fortran.exp

# Copyright 2015-2017 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/>.

# Verify that, using the MI, we can evaluate a simple C Variable Length
# Array (VLA).

load_lib mi-support.exp
set MIFLAGS "-i=mi"

gdb_exit
if [mi_gdb_start] {
    continue
}

standard_testfile vla.f90

if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable \
     {debug f90}] != "" } {
     untested "failed to compile"
     return -1
}

mi_delete_breakpoints
mi_gdb_reinitialize_dir $srcdir/$subdir
mi_gdb_load ${binfile}

set bp_lineno [gdb_get_line_number "vla1-not-allocated"]
mi_create_breakpoint "-t vla.f90:$bp_lineno" \
    "insert breakpoint at line $bp_lineno (vla not allocated)" \
    -number 1 -disp del -func vla ".*vla.f90" $bp_lineno $hex
mi_run_cmd
mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
  { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
mi_gdb_test "500-data-evaluate-expression vla1" \
  "500\\^done,value=\"<not allocated>\"" "evaluate not allocated vla, before allocation"

mi_create_varobj_checked vla1_not_allocated vla1 "<not allocated>" \
  "create local variable vla1_not_allocated"
mi_gdb_test "501-var-info-type vla1_not_allocated" \
  "501\\^done,type=\"<not allocated>\"" \
  "info type variable vla1_not_allocated"
mi_gdb_test "502-var-show-format vla1_not_allocated" \
  "502\\^done,format=\"natural\"" \
  "show format variable vla1_not_allocated"
mi_gdb_test "503-var-evaluate-expression vla1_not_allocated" \
  "503\\^done,value=\"\\\[0\\\]\"" \
  "eval variable vla1_not_allocated"
mi_list_array_varobj_children_with_index "vla1_not_allocated" "0" "1" \
    "real\\\(kind=4\\\)" "get children of vla1_not_allocated"


set bp_lineno [gdb_get_line_number "vla1-allocated"]
mi_create_breakpoint "-t vla.f90:$bp_lineno" \
    "insert breakpoint at line $bp_lineno (vla allocated)" \
    -number 2 -disp del -func vla ".*vla.f90" $bp_lineno $hex
mi_run_cmd
mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
  { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
mi_gdb_test "510-data-evaluate-expression vla1" \
  "510\\^done,value=\"\\(.*\\)\"" "evaluate allocated vla"

mi_create_varobj_checked vla1_allocated vla1 "real\\\(kind=4\\\) \\\(5\\\)" \
  "create local variable vla1_allocated"
mi_gdb_test "511-var-info-type vla1_allocated" \
  "511\\^done,type=\"real\\\(kind=4\\\) \\\(5\\\)\"" \
  "info type variable vla1_allocated"
mi_gdb_test "512-var-show-format vla1_allocated" \
  "512\\^done,format=\"natural\"" \
  "show format variable vla1_allocated"
mi_gdb_test "513-var-evaluate-expression vla1_allocated" \
  "513\\^done,value=\"\\\[5\\\]\"" \
  "eval variable vla1_allocated"
mi_list_array_varobj_children_with_index "vla1_allocated" "5" "1" \
    "real\\\(kind=4\\\)" "get children of vla1_allocated"


set bp_lineno [gdb_get_line_number "vla1-filled"]
mi_create_breakpoint "-t vla.f90:$bp_lineno" \
    "insert breakpoint at line $bp_lineno" \
    -number 3 -disp del -func vla ".*vla.f90" $bp_lineno $hex
mi_run_cmd
mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
  { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
mi_gdb_test "520-data-evaluate-expression vla1" \
  "520\\^done,value=\"\\(1, 1, 1, 1, 1\\)\"" "evaluate filled vla, filled all 1s"


set bp_lineno [gdb_get_line_number "vla1-modified"]
mi_create_breakpoint "-t vla.f90:$bp_lineno" \
    "insert breakpoint at line $bp_lineno" \
    -number 4 -disp del -func vla ".*vla.f90" $bp_lineno $hex
mi_run_cmd
mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
  { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
mi_gdb_test "530-data-evaluate-expression vla1" \
  "530\\^done,value=\"\\(1, 42, 1, 24, 1\\)\"" "evaluate filled vla, contents modified"
mi_gdb_test "540-data-evaluate-expression vla1(1)" \
  "540\\^done,value=\"1\"" "evaluate filled vla(1)"
mi_gdb_test "550-data-evaluate-expression vla1(2)" \
  "550\\^done,value=\"42\"" "evaluate filled vla(2)"
mi_gdb_test "560-data-evaluate-expression vla1(4)" \
  "560\\^done,value=\"24\"" "evaluate filled vla(4)"


set bp_lineno [gdb_get_line_number "vla1-deallocated"]
mi_create_breakpoint "-t vla.f90:$bp_lineno" \
    "insert breakpoint at line $bp_lineno" \
    -number 5 -disp del -func vla ".*vla.f90" $bp_lineno $hex
mi_run_cmd
mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
  { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
mi_gdb_test "570-data-evaluate-expression vla1" \
  "570\\^done,value=\"<not allocated>\"" "evaluate not allocated vla, after deallocation"


set bp_lineno [gdb_get_line_number "pvla2-not-associated"]
mi_create_breakpoint "-t vla.f90:$bp_lineno" \
    "insert breakpoint at line $bp_lineno" \
    -number 6 -disp "del" -func "vla" ".*vla.f90" $bp_lineno $hex
mi_run_cmd
mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
  { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"


set test "evaluate not associated vla"
send_gdb "580-data-evaluate-expression pvla2\n"
gdb_expect {
    -re "580\\^done,value=\"<not associated>\".*${mi_gdb_prompt}$" {
	pass $test

	mi_create_varobj_checked pvla2_not_associated pvla2 "<not associated>" \
	    "create local variable pvla2_not_associated"
	mi_gdb_test "581-var-info-type pvla2_not_associated" \
	    "581\\^done,type=\"<not associated>\"" \
	    "info type variable pvla2_not_associated"
	mi_gdb_test "582-var-show-format pvla2_not_associated" \
	    "582\\^done,format=\"natural\"" \
	    "show format variable pvla2_not_associated"
	mi_gdb_test "583-var-evaluate-expression pvla2_not_associated" \
	    "583\\^done,value=\"\\\[0\\\]\"" \
	    "eval variable pvla2_not_associated"
	mi_list_array_varobj_children_with_index "pvla2_not_associated" "0" "1" \
	    "real\\\(kind=4\\\)" "get children of pvla2_not_associated"
    }
    -re "580\\^error,msg=\"value contents too large \\(\[0-9\]+ bytes\\).*${mi_gdb_prompt}$" {
	# Undefined behaviour in gfortran.
	xfail $test
    }
    -re "${mi_gdb_prompt}$" {
	fail $test
    }
    timeout {
	fail "$test (timeout)"
    }
}

set bp_lineno [gdb_get_line_number "pvla2-associated"]
mi_create_breakpoint "-t vla.f90:$bp_lineno" \
    "insert breakpoint at line $bp_lineno" \
    -number 7 -disp del -func vla ".*vla.f90" $bp_lineno $hex
mi_run_cmd
mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
  { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
mi_gdb_test "590-data-evaluate-expression pvla2" \
  "590\\^done,value=\"\\(\\( 2, 2, 2, 2, 2\\) \\( 2, 2, 2, 2, 2\\) \\)\"" \
  "evaluate associated vla"

mi_create_varobj_checked pvla2_associated pvla2 \
  "real\\\(kind=4\\\) \\\(5,2\\\)" "create local variable pvla2_associated"
mi_gdb_test "591-var-info-type pvla2_associated" \
  "591\\^done,type=\"real\\\(kind=4\\\) \\\(5,2\\\)\"" \
  "info type variable pvla2_associated"
mi_gdb_test "592-var-show-format pvla2_associated" \
  "592\\^done,format=\"natural\"" \
  "show format variable pvla2_associated"
mi_gdb_test "593-var-evaluate-expression pvla2_associated" \
  "593\\^done,value=\"\\\[2\\\]\"" \
  "eval variable pvla2_associated"


set bp_lineno [gdb_get_line_number "pvla2-set-to-null"]
mi_create_breakpoint "-t vla.f90:$bp_lineno" \
    "insert breakpoint at line $bp_lineno" \
    -number 8 -disp del -func vla ".*vla.f90" $bp_lineno $hex
mi_run_cmd
mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
  { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
mi_gdb_test "600-data-evaluate-expression pvla2" \
  "600\\^done,value=\"<not associated>\"" "evaluate vla pointer set to null"

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