gdb/testsuite/gdb.fortran/call-no-debug.exp

   1 # Copyright 2020-2022 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 # Test calling Fortran functions that are compiled without debug
  17 # information.
  18
  19 if {[skip_fortran_tests]} { return -1 }
  20
  21 standard_testfile call-no-debug-prog.f90 call-no-debug-func.f90
  22 load_lib fortran.exp
  23
  24 if {[prepare_for_testing_full "failed to prepare" \
  25          [list ${binfile} [list debug f90] \
  26               $srcfile [list debug f90] \
  27               $srcfile2 [list nodebug f90]]]} {
  28     return -1
  29 }
  30
  31 # Find a possibly mangled version of NAME, a function we want to call
  32 # that has no debug information available.  We hope that the mangled
  33 # version of NAME contains the pattern NAME, and so we use 'info
  34 # functions' to find a possible suitable symbol.
  35 #
  36 # If no suitable function is found then return the empty string.
  37 proc find_mangled_name { name } {
  38     global hex gdb_prompt
  39
  40     set into_non_debug_symbols false
  41     set symbol_name "*unknown*"
  42     gdb_test_multiple "info function $name" "" {
  43         -re ".*Non-debugging symbols:\r\n" {
  44             set into_non_debug_symbols true
  45             exp_continue
  46         }
  47         -re "$hex.*\[ \t\]+(\[^\r\n\]+)\r\n" {
  48             set symbol_name $expect_out(1,string)
  49             exp_continue
  50         }
  51         -re "^$gdb_prompt $" {
  52             # Done.
  53         }
  54     }
  55
  56     # If we couldn't find a suitable symbol name return the empty
  57     # string.
  58     if { $symbol_name == "*unknown*" } {
  59         return ""
  60     }
  61
  62     return $symbol_name
  63 }
  64
  65 # Sample before before starting the exec, in order to avoid picking up symbols
  66 # from shared libs.
  67 set some_func [find_mangled_name "some_func"]
  68 set string_func [find_mangled_name "string_func"]
  69
  70 if ![fortran_runto_main] {
  71     untested "could not run to main"
  72     return -1
  73 }
  74
  75 # Call the function SOME_FUNC, that takes a single integer and returns
  76 # an integer.  As the function has no debug information then we have
  77 # to pass the integer argument as '&1' so that GDB will send the
  78 # address of an integer '1' (as Fortran arguments are pass by
  79 # reference).
  80 set symbol_name $some_func
  81 if { $symbol_name == "" } {
  82     untested "couldn't find suitable name for 'some_func'"
  83 } else {
  84     gdb_test "ptype ${symbol_name}" "type = <unknown return type> \\(\\)"
  85     gdb_test "print ${symbol_name} (&1)" \
  86         "'${symbol_name}' has unknown return type; cast the call to its declared return type"
  87     gdb_test "print (integer) ${symbol_name} (&1)" " = 2"
  88 }
  89
  90 # Call the function STRING_FUNC which takes an assumed shape character
  91 # array (i.e. a string), and returns an integer.
  92 #
  93 # At least for gfortran, passing the string will pass both the data
  94 # pointer and an artificial argument, the length of the string.
  95 #
  96 # The compiled program is expecting the address of the string, so we
  97 # prefix that argument with '&', but the artificial length parameter
  98 # is pass by value, so there's no need for '&' in that case.
  99 set symbol_name $string_func
 100 if { $symbol_name == "" } {
 101     untested "couldn't find suitable name for 'string_func'"
 102 } else {
 103     gdb_test "ptype ${symbol_name}" "type = <unknown return type> \\(\\)"
 104     gdb_test "print ${symbol_name} (&'abcdefg', 3)" \
 105         "'${symbol_name}' has unknown return type; cast the call to its declared return type"
 106     gdb_test "call (integer) ${symbol_name} (&'abcdefg', 3)" " abc\r\n\\\$\\d+ = 0"
 107 }