mirror of
https://sourceware.org/git/binutils-gdb.git
synced 2025-03-07 13:39:43 +08:00
gdb, testsuite, fortran: Fix sizeof intrinsic for Fortran pointers
For Fortran pointers gfortran/ifx emits DW_TAG_pointer_types like <2><17d>: Abbrev Number: 22 (DW_TAG_variable) <180> DW_AT_name : (indirect string, offset: 0x1f1): fptr <184> DW_AT_type : <0x214> ... <1><219>: Abbrev Number: 27 (DW_TAG_array_type) <21a> DW_AT_type : <0x10e> <216> DW_AT_associated : ... The 'pointer property' in Fortran is implicitly modeled by adding a DW_AT_associated to the type of the variable (see also the DW_AT_associated description in DWARF 5). A Fortran pointer is more than an address and thus different from a C pointer. It is a self contained type having additional fields such as, e.g., the rank of its underlying array. This motivates the intended DWARF modeling of Fortran pointers via the DW_AT_associated attribute. This patch adds support for the sizeof intrinsic by simply dereferencing pointer types when encountered during a sizeof evaluation. The patch also adds a test for the sizeof intrinsic which was not tested before. Tested-by: Thiago Jung Bauermann <thiago.bauermann@linaro.org> Approved-By: Tom Tromey <tom@tromey.com>
This commit is contained in:
Nils-Christian Kempke
Ijaz, Abdul B
parent
f18fc7e56f
commit
6a67441983
@ -2708,6 +2708,13 @@ evaluate_subexp_for_sizeof_base (struct expression *exp, struct type *type)
|
||||
if (exp->language_defn->la_language == language_cplus
|
||||
&& (TYPE_IS_REFERENCE (type)))
|
||||
type = check_typedef (type->target_type ());
|
||||
else if (exp->language_defn->la_language == language_fortran
|
||||
&& type->code () == TYPE_CODE_PTR)
|
||||
{
|
||||
/* Dereference Fortran pointer types to allow them for the Fortran
|
||||
sizeof intrinsic. */
|
||||
type = check_typedef (type->target_type ());
|
||||
}
|
||||
return value_from_longest (size_type, (LONGEST) type->length ());
|
||||
}
|
||||
|
||||
|
||||
115
gdb/testsuite/gdb.fortran/sizeof.exp
Normal file
115
gdb/testsuite/gdb.fortran/sizeof.exp
Normal file
@ -0,0 +1,115 @@
|
||||
# Copyright 2024 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/> .
|
||||
|
||||
# Testing GDB's implementation of SIZE keyword.
|
||||
|
||||
require allow_fortran_tests
|
||||
|
||||
standard_testfile ".f90"
|
||||
load_lib fortran.exp
|
||||
|
||||
if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
|
||||
{debug f90}]} {
|
||||
return -1
|
||||
}
|
||||
|
||||
if ![fortran_runto_main] {
|
||||
return -1
|
||||
}
|
||||
|
||||
gdb_breakpoint [gdb_get_line_number "Test breakpoint"]
|
||||
gdb_breakpoint [gdb_get_line_number "Past unassigned pointers"]
|
||||
gdb_breakpoint [gdb_get_line_number "Final breakpoint"]
|
||||
|
||||
set done_unassigned 0
|
||||
set found_final_breakpoint 0
|
||||
set test_count 0
|
||||
|
||||
# We are running tests defined in the executable here. So, in the .exp file
|
||||
# we do not know when the 'Final breakpoint' will be hit exactly. We place a
|
||||
# limit on the number of tests that can be run, just in case something goes
|
||||
# wrong, and GDB gets stuck in an loop here.
|
||||
while { $test_count < 200 } {
|
||||
with_test_prefix "test $test_count" {
|
||||
incr test_count
|
||||
|
||||
gdb_test_multiple "continue" "continue" {
|
||||
-re -wrap "! Test breakpoint" {
|
||||
# We can run a test from here.
|
||||
}
|
||||
-re -wrap "! Past unassigned pointers" {
|
||||
# Done with testing unassigned pointers.
|
||||
set done_unassigned 1
|
||||
continue
|
||||
}
|
||||
-re -wrap "! Final breakpoint" {
|
||||
# We're done with the tests.
|
||||
set found_final_breakpoint 1
|
||||
}
|
||||
}
|
||||
|
||||
if ($found_final_breakpoint) {
|
||||
break
|
||||
}
|
||||
|
||||
# First grab the expected answer.
|
||||
set answer [get_valueof "" "answer" "**unknown**"]
|
||||
|
||||
# Now move up a frame and figure out a command for us to run
|
||||
# as a test.
|
||||
set command ""
|
||||
gdb_test_multiple "up" "up" {
|
||||
-re -wrap "\r\n\[0-9\]+\[ \t\]+call test_sizeof \\((\[^\r\n\]+)\\)" {
|
||||
set command $expect_out(1,string)
|
||||
}
|
||||
}
|
||||
|
||||
gdb_assert { ![string equal $command ""] } "found a command to run"
|
||||
|
||||
set is_pointer_to_array [string match "sizeof (*a_p)*" $command]
|
||||
|
||||
if {$done_unassigned || !$is_pointer_to_array} {
|
||||
gdb_test "p $command" " = $answer"
|
||||
} else {
|
||||
# Gfortran and ifx have slightly different behavior for unassigned
|
||||
# pointers to arrays. While ifx will print 0 as the sizeof result,
|
||||
# gfortran will print the size of the base type of the pointer or
|
||||
# array. Since the default behavior in GDB was to print 0 we keep
|
||||
# this and make an exception for gfortran here.
|
||||
gdb_test_multiple "p $command" "p $command" {
|
||||
-re -wrap " = $answer" {
|
||||
pass $gdb_test_name
|
||||
}
|
||||
-re -wrap " = 0" {
|
||||
pass $gdb_test_name
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
gdb_assert {$found_final_breakpoint} "ran all compiled in tests"
|
||||
|
||||
# Here some more GDB specific tests that might fail with compilers.
|
||||
# GDB will print sizeof(1.4) = 8 while gfortran will probably print 4 but
|
||||
# GDB says ptype 1.4 is real*8 so the output is expected.
|
||||
|
||||
gdb_test "ptype 1" "type = int"
|
||||
gdb_test "p sizeof(1)" "= 4"
|
||||
|
||||
gdb_test "ptype 1.3" "type = real\\*8"
|
||||
gdb_test "p sizeof(1.3)" "= 8"
|
||||
|
||||
gdb_test "p sizeof ('asdsasd')" "= 7"
|
||||
108
gdb/testsuite/gdb.fortran/sizeof.f90
Normal file
108
gdb/testsuite/gdb.fortran/sizeof.f90
Normal file
@ -0,0 +1,108 @@
|
||||
! Copyright 2024 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/>.
|
||||
|
||||
module data
|
||||
use, intrinsic :: iso_c_binding, only : C_SIZE_T
|
||||
implicit none
|
||||
|
||||
character, target :: char_v
|
||||
character (len=3), target :: char_a
|
||||
integer, target :: int_v
|
||||
integer, target, dimension(:,:) :: int_2da (3,2)
|
||||
real*4, target :: real_v
|
||||
real*4, target :: real_a(4)
|
||||
real*4, target, dimension (:), allocatable :: real_a_alloc
|
||||
|
||||
character, pointer :: char_v_p
|
||||
character (len=3), pointer :: char_a_p
|
||||
integer, pointer :: int_v_p
|
||||
integer, pointer, dimension (:,:) :: int_2da_p
|
||||
real*4, pointer :: real_v_p
|
||||
real*4, pointer, dimension(:) :: real_a_p
|
||||
real*4, dimension(:), pointer :: real_alloc_a_p
|
||||
|
||||
contains
|
||||
subroutine test_sizeof (answer)
|
||||
integer(C_SIZE_T) :: answer
|
||||
|
||||
print *, answer ! Test breakpoint
|
||||
end subroutine test_sizeof
|
||||
|
||||
subroutine run_tests ()
|
||||
call test_sizeof (sizeof (char_v))
|
||||
call test_sizeof (sizeof (char_a))
|
||||
call test_sizeof (sizeof (int_v))
|
||||
call test_sizeof (sizeof (int_2da))
|
||||
call test_sizeof (sizeof (real_v))
|
||||
call test_sizeof (sizeof (real_a))
|
||||
call test_sizeof (sizeof (real_a_alloc))
|
||||
|
||||
call test_sizeof (sizeof (char_v_p))
|
||||
call test_sizeof (sizeof (char_a_p))
|
||||
call test_sizeof (sizeof (int_v_p))
|
||||
call test_sizeof (sizeof (int_2da_p))
|
||||
call test_sizeof (sizeof (real_v_p))
|
||||
call test_sizeof (sizeof (real_a_p))
|
||||
call test_sizeof (sizeof (real_alloc_a_p))
|
||||
end subroutine run_tests
|
||||
|
||||
end module data
|
||||
|
||||
program sizeof_tests
|
||||
use iso_c_binding
|
||||
use data
|
||||
|
||||
implicit none
|
||||
|
||||
allocate (real_a_alloc(5))
|
||||
|
||||
nullify (char_v_p)
|
||||
nullify (char_a_p)
|
||||
nullify (int_v_p)
|
||||
nullify (int_2da_p)
|
||||
nullify (real_v_p)
|
||||
nullify (real_a_p)
|
||||
nullify (real_alloc_a_p)
|
||||
|
||||
! Test nullified
|
||||
call run_tests ()
|
||||
|
||||
char_v_p => char_v ! Past unassigned pointers
|
||||
char_a_p => char_a
|
||||
int_v_p => int_v
|
||||
int_2da_p => int_2da
|
||||
real_v_p => real_v
|
||||
real_a_p => real_a
|
||||
real_alloc_a_p => real_a_alloc
|
||||
|
||||
! Test pointer assignment
|
||||
call run_tests ()
|
||||
|
||||
char_v = 'a'
|
||||
char_a = "aaa"
|
||||
int_v = 10
|
||||
int_2da = reshape((/1, 2, 3, 4, 5, 6/), shape(int_2da))
|
||||
real_v = 123.123
|
||||
real_a_p = (/-1.1, -1.2, -1.3, -1.4/)
|
||||
real_a_alloc = (/1.1, 2.2, 3.3, 4.4, 5.5/)
|
||||
|
||||
! After allocate/value assignment
|
||||
call run_tests ()
|
||||
|
||||
deallocate (real_a_alloc)
|
||||
|
||||
print *, "done" ! Final breakpoint
|
||||
|
||||
end program sizeof_tests
|
||||
Loading…
Reference in New Issue
Block a user