+2020-03-19 Andrew Burgess <andrew.burgess@embecosm.com>
+
+ * gdb.fortran/mixed-lang-stack.c: New file.
+ * gdb.fortran/mixed-lang-stack.cpp: New file.
+ * gdb.fortran/mixed-lang-stack.exp: New file.
+ * gdb.fortran/mixed-lang-stack.f90: New file.
+
2020-03-19 Andrew Burgess <andrew.burgess@embecosm.com>
* gdb.linespec/cp-completion-aliases.cc: New file.
--- /dev/null
+/* Copyright 2020 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 2 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/>. */
+
+#include <stdio.h>
+#include <complex.h>
+#include <string.h>
+
+struct some_struct
+{
+ float a, b;
+};
+
+extern void mixed_func_1d_ (int *, float *, double *, complex float *,
+ char *, size_t);
+
+void
+mixed_func_1c (int a, float b, double c, complex float d, char *f,
+ struct some_struct *g)
+{
+ printf ("a = %d, b = %f, c = %e, d = (%f + %fi)\n", a, b, c,
+ creal(d), cimag(d));
+
+ char *string = "this is a string from C";
+ mixed_func_1d_ (&a, &b, &c, &d, string, strlen (string));
+}
--- /dev/null
+/* Copyright 2020 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 2 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/>. */
+
+#include <cstring>
+#include <cstdlib>
+
+class base_one
+{
+ int num1 = 1;
+ int num2 = 2;
+ int num3 = 3;
+};
+
+class base_two
+{
+public:
+ base_two ()
+ {
+ string = strdup ("Something in C++");
+ }
+
+ ~base_two ()
+ {
+ free (string);
+ }
+
+ char *string = nullptr;
+ float val = 3.5;
+};
+
+class derived_type : public base_one, base_two
+{
+public:
+ derived_type ()
+ : base_one (),
+ base_two ()
+ {
+ /* Nothing. */
+ }
+
+private:
+ int xxx = 9;
+ float yyy = 10.5;
+};
+
+static void mixed_func_1f ();
+static void mixed_func_1g ();
+
+extern "C"
+{
+ /* Entry point to be called from Fortran. */
+ void
+ mixed_func_1e ()
+ {
+ mixed_func_1f ();
+ }
+
+ /* The entry point back into Fortran. */
+ extern void mixed_func_1h_ ();
+}
+
+static void
+mixed_func_1g (derived_type obj)
+{
+ mixed_func_1h_ ();
+}
+
+static void
+mixed_func_1f () {
+ derived_type obj;
+
+ mixed_func_1g (obj);
+}
--- /dev/null
+# Copyright 2020 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/> .
+
+# This test covers some basic functionality for debugging mixed
+# Fortran, C, and C++ applications. Features tested include examining
+# the backtrace, and printing frame arguments in frames of different
+# languages.
+#
+# One important aspect of this test is that we set the language in
+# turn to auto, fortran, c, and c++, and carry out the full test in
+# each case to ensure that trying to print objects or types from one
+# language, while GDB's language is set to another, doesn't crash GDB.
+
+if {[skip_fortran_tests]} { return -1 }
+
+standard_testfile mixed-lang-stack.c mixed-lang-stack.cpp mixed-lang-stack.f90
+
+if {[prepare_for_testing_full "failed to prepare" \
+ [list ${binfile} {debug f90 additional_flags=-lstdc++} \
+ $srcfile {debug} \
+ $srcfile2 {debug c++} \
+ $srcfile3 {debug f90}]]} {
+ return -1
+}
+
+# Runs the test program and examins the stack. LANG is a string, the
+# value to pass to GDB's 'set language ...' command.
+proc run_tests { lang } {
+ with_test_prefix "lang=${lang}" {
+ global binfile hex
+
+ clean_restart ${binfile}
+
+ if ![runto_main] {
+ untested "could not run to main"
+ return -1
+ }
+
+ gdb_breakpoint "breakpt"
+ gdb_continue_to_breakpoint "breakpt"
+
+ if { $lang == "c" || $lang == "c++" } {
+ gdb_test "set language c" \
+ "Warning: the current language does not match this frame."
+ } else {
+ gdb_test_no_output "set language $lang"
+ }
+
+ # Check the backtrace.
+ set bt_stack [multi_line \
+ "#0\\s+breakpt \\(\\) at \[^\r\n\]+" \
+ "#1\\s+$hex in mixed_func_1h \\(\\) at \[^\r\n\]+" \
+ "#2\\s+$hex in mixed_func_1g \\(obj=\\.\\.\\.\\) at \[^\r\n\]+" \
+ "#3\\s+$hex in mixed_func_1f \\(\\) at \[^\r\n\]+" \
+ "#4\\s+$hex in mixed_func_1e \\(\\) at \[^\r\n\]+" \
+ "#5\\s+$hex in mixed_func_1d \\(\[^\r\n\]+\\) at \[^\r\n\]+" \
+ "#6\\s+$hex in mixed_func_1c \\(\[^\r\n\]+\\) at \[^\r\n\]+" \
+ "#7\\s+$hex in mixed_func_1b \\(\[^\r\n\]+\\) at \[^\r\n\]+" \
+ "#8\\s+$hex in mixed_func_1a \\(\\) at \[^\r\n\]+" \
+ "#9\\s+$hex in mixed_stack_main \\(\\) at \[^\r\n\]+" \
+ "#10\\s+$hex in main \\(\[^\r\n\]+\\) at .*" ]
+ gdb_test "bt" $bt_stack
+
+ # Check the language for frame #0.
+ gdb_test "info frame" "source language fortran\..*" \
+ "info frame in frame #0"
+
+ # Move up to the C++ frames and check the frame state, print a
+ # C++ object.
+ gdb_test "frame 2" "#2\\s+$hex in mixed_func_1g .*" \
+ "select frame #2"
+ gdb_test "info frame" "source language c\\+\\+\..*" \
+ "info frame in frame #2"
+ if { $lang == "fortran" } {
+ set obj_pattern " = \\( base_one = \\( num1 = 1, num2 = 2, num3 = 3 \\), base_two = \\( string = 0x6184e0 'Something in C\\+\\+\\\\000', val = 3.5 \\), xxx = 9, yyy = 10.5 \\)"
+ } else {
+ set obj_pattern " = \\{<base_one> = \\{num1 = 1, num2 = 2, num3 = 3\\}, <base_two> = \\{string = 0x6184e0 \"Something in C\\+\\+\", val = 3.5\\}, xxx = 9, yyy = 10.5\\}"
+ }
+ gdb_test "print obj" "${obj_pattern}"
+
+ # Move up the stack a way, and check frame and the frame
+ # arguments.
+ gdb_test "frame 5" "#5\\s+$hex in mixed_func_1d .*" \
+ "select frame #5"
+ gdb_test "info frame" "source language fortran\..*" \
+ "info frame in frame #5"
+
+ gdb_test "up" "#6\\s+$hex in mixed_func_1c .*" \
+ "up to frame #6"
+ gdb_test "info frame" "source language c\..*" \
+ "info frame in frame #6"
+
+ if { $lang == "fortran" } {
+ set d_pattern "\\(4,5\\)"
+ set f_pattern "$hex 'abcdef\\\\000'"
+ } else {
+ set d_pattern "4 \\+ 5 \\* I"
+ set f_pattern "$hex \"abcdef\""
+ }
+
+ set args_pattern [multi_line \
+ "a = 1" \
+ "b = 2" \
+ "c = 3" \
+ "d = ${d_pattern}" \
+ "f = ${f_pattern}" \
+ "g = $hex" ]
+
+ gdb_test "info args" $args_pattern \
+ "info args in frame #6"
+ if { $lang == "fortran" } {
+ set g_pattern " = \\( a = 1\\.5, b = 2\\.5 \\)"
+ } else {
+ set g_pattern " = \\{a = 1\\.5, b = 2\\.5\\}"
+ }
+ gdb_test "print *g" "${g_pattern}" \
+ "print object pointed to by g"
+
+ gdb_test "up" "#7\\s+$hex in mixed_func_1b .*" \
+ "up to frame #7"
+ gdb_test "info frame" "source language fortran\..*" \
+ "info frame in frame #7"
+
+ if { $lang == "c" || $lang == "c++" } {
+ set d_pattern "4 \\+ 5 \\* I"
+ set e_pattern "\"abcdef\""
+ set g_pattern "\{a = 1.5, b = 2.5\}"
+ } else {
+ set d_pattern "\\(4,5\\)"
+ set e_pattern "'abcdef'"
+ set g_pattern "\\( a = 1.5, b = 2.5 \\)"
+ }
+
+ set args_pattern [multi_line \
+ "a = 1" \
+ "b = 2" \
+ "c = 3" \
+ "d = ${d_pattern}" \
+ "e = ${e_pattern}" \
+ "g = ${g_pattern}" \
+ "_e = 6" ]
+
+ gdb_test "info args" $args_pattern \
+ "info args in frame #7"
+ }
+}
+
+run_tests "auto"
+run_tests "fortran"
+run_tests "c"
+run_tests "c++"
--- /dev/null
+! Copyright 2020 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 2 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/>.
+
+module type_module
+ use, intrinsic :: iso_c_binding, only: c_int, c_float, c_double
+ type, bind(C) :: MyType
+ real(c_float) :: a
+ real(c_float) :: b
+ end type MyType
+end module type_module
+
+program mixed_stack_main
+ implicit none
+
+ ! Set up some locals.
+
+ ! Call a Fortran function.
+ call mixed_func_1a
+
+ write(*,*) "All done"
+end program mixed_stack_main
+
+subroutine breakpt ()
+ implicit none
+ write(*,*) "Hello World" ! Break here.
+end subroutine breakpt
+
+subroutine mixed_func_1a()
+ use type_module
+ implicit none
+
+ TYPE(MyType) :: obj
+ complex(kind=4) :: d
+
+ obj%a = 1.5
+ obj%b = 2.5
+ d = cmplx (4.0, 5.0)
+
+ ! Call a C function.
+ call mixed_func_1b (1, 2.0, 3D0, d, "abcdef", obj)
+end subroutine mixed_func_1a
+
+! This subroutine is called from the Fortran code.
+subroutine mixed_func_1b(a, b, c, d, e, g)
+ use type_module
+ implicit none
+
+ integer :: a
+ real(kind=4) :: b
+ real(kind=8) :: c
+ complex(kind=4) :: d
+ character(len=*) :: e
+ character(len=:), allocatable :: f
+ TYPE(MyType) :: g
+
+ interface
+ subroutine mixed_func_1c (a, b, c, d, f, g) bind(C)
+ use, intrinsic :: iso_c_binding, only: c_int, c_float, c_double
+ use, intrinsic :: iso_c_binding, only: c_float_complex, c_char
+ use type_module
+ implicit none
+ integer(c_int), value, intent(in) :: a
+ real(c_float), value, intent(in) :: b
+ real(c_double), value, intent(in) :: c
+ complex(c_float_complex), value, intent(in) :: d
+ character(c_char), intent(in) :: f(*)
+ TYPE(MyType) :: g
+ end subroutine mixed_func_1c
+ end interface
+
+ ! Create a copy of the string with a NULL terminator on the end.
+ f = e//char(0)
+
+ ! Call a C function.
+ call mixed_func_1c (a, b, c, d, f, g)
+end subroutine mixed_func_1b
+
+! This subroutine is called from the C code.
+subroutine mixed_func_1d(a, b, c, d, str)
+ use, intrinsic :: iso_c_binding, only: c_int, c_float, c_double
+ use, intrinsic :: iso_c_binding, only: c_float_complex
+ implicit none
+ integer(c_int) :: a
+ real(c_float) :: b
+ real(c_double) :: c
+ complex(c_float_complex) :: d
+ character(len=*) :: str
+
+ interface
+ subroutine mixed_func_1e () bind(C)
+ implicit none
+ end subroutine mixed_func_1e
+ end interface
+
+ write(*,*) a, b, c, d, str
+
+ ! Call a C++ function (via an extern "C" wrapper).
+ call mixed_func_1e
+end subroutine mixed_func_1d
+
+! This is called from C++ code.
+subroutine mixed_func_1h ()
+ call breakpt
+end subroutine mixed_func_1h
projects / binutils-gdb.git / commitdiff