Re: [PATCH v2 3/7] Fortran: Accessing fields of inherited types via fully qualified name.

[Paweł Wódkowski <pwodkowski at pl dot sii dot eu>]

On 03.12.2018 14:44, Richard Bunt wrote:
> Hi Pawel,
> 
> Is there a compiler where all the marked kfails pass? I've given this patch a spin
> with the Fortran compilers from various vendors, but there is a varying number of kfails.
> 

To be honest I'm testing gfortran and ifort and both are producing the 
same six kfails.

Which compilers are you testing against? I can add them to the CI if 
required.

Pawel

> I'd like to test everything if possible.
> 
> Many thanks,
> 
> Rich
> 
> On 11/19/18 9:38 PM, Pawel Wodkowski wrote:
>> From: Bernhard Heckel <bernhard.heckel@intel.com>
>>
>> Fortran 2003 supports type extension. This patch allows access
>> to inherited members by using it's fully qualified name as
>> described in the fortran standard.
>>
>> Before:
>> (gdb) print my_extended_obj%base_class_name%member_base
>> Syntax error near base_class_name%member_base
>>
>> (gdb) print my_extended_obj%member_base
>> $1 = (10, 10, 10)
>>
>> After:
>> (gdb) print my_extended_obj%base_clase_name%member_base
>> $1 = (10, 10, 10)
>>
>> (gdb) print my_extended_obj%member_base
>> $1 = (10, 10, 10)
>>
>> 2016-04-22  Bernhard Heckel  <bernhard.heckel@intel.com>
>>
>> gdb/Changelog:
>> 	* f-exp.y (name): Allow TYPENAME.
>> 	* valops.c (search_struct_method): Look also for baseclass.
>>
>> gdb/Testsuite/Changelog:
>> 	* gdb.fortran/oop-extend-type.f90: New.
>> 	* gdb.fortran/oop-extend-type.exp: New.
>> ---
>>   gdb/f-exp.y                                   |   7 +-
>>   gdb/testsuite/gdb.fortran/oop-extend-type.exp | 113 ++++++++++++++++++++++++++
>>   gdb/testsuite/gdb.fortran/oop-extend-type.f90 |  56 +++++++++++++
>>   gdb/valops.c                                  |   6 ++
>>   4 files changed, 180 insertions(+), 2 deletions(-)
>>   create mode 100644 gdb/testsuite/gdb.fortran/oop-extend-type.exp
>>   create mode 100644 gdb/testsuite/gdb.fortran/oop-extend-type.f90
>>
>> diff --git a/gdb/f-exp.y b/gdb/f-exp.y
>> index 390bd45081b7..4c2e101699ac 100644
>> --- a/gdb/f-exp.y
>> +++ b/gdb/f-exp.y
>> @@ -604,8 +604,11 @@ nonempty_typelist
>>   		}
>>   	;
>>   
>> -name	:	NAME
>> -		{  $$ = $1.stoken; }
>> +name
>> +	:	NAME
>> +		{ $$ = $1.stoken; }
>> +	|	TYPENAME
>> +		{ $$ = $1.stoken; }
>>   	;
>>   
>>   name_not_typename :	NAME
>> diff --git a/gdb/testsuite/gdb.fortran/oop-extend-type.exp b/gdb/testsuite/gdb.fortran/oop-extend-type.exp
>> new file mode 100644
>> index 000000000000..8c3bb50a3ac6
>> --- /dev/null
>> +++ b/gdb/testsuite/gdb.fortran/oop-extend-type.exp
>> @@ -0,0 +1,113 @@
>> +# Copyright 2018 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/>.
>> +
>> +standard_testfile ".f90"
>> +load_lib "fortran.exp"
>> +
>> +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
>> +     {debug f90 quiet}] } {
>> +	 return -1
>> +}
>> +
>> +if ![runto_main] {
>> +    untested "could not run to main"
>> +    return -1
>> +}
>> +
>> +# Depending on the compiler being used, the type names can be printed differently.
>> +set real [fortran_real4]
>> +
>> +gdb_breakpoint [gdb_get_line_number "! Before vla allocation"]
>> +gdb_continue_to_breakpoint "! Before vla allocation" ".*! Before vla allocation"
>> +gdb_test "whatis wp_vla" "type = <not allocated>"
>> +
>> +gdb_breakpoint [gdb_get_line_number "! After value assignment"]
>> +gdb_continue_to_breakpoint "! After value assignment" ".*! After value assignment"
>> +set test "p wp%coo"
>> +gdb_test_multiple "$test" "$test" {
>> +    -re " = \\(1, 2, 1\\)\r\n$gdb_prompt $" {
>> +      pass "$test"
>> +    }
>> +    -re "There is no member named coo.\r\n$gdb_prompt $" {
>> +      kfail "gcc/49475" "$test"
>> +    }
>> +}
>> +gdb_test "p wp%point%coo" " = \\(1, 2, 1\\)"
>> +gdb_test "p wp%point" " = \\( coo = \\(1, 2, 1\\) \\)"
>> +gdb_test "p wp" " = \\( point = \\( coo = \\(1, 2, 1\\) \\), angle = 100 \\)"
>> +
>> +gdb_test "whatis wp" "type = Type waypoint"
>> +set output_pass [multi_line "type = Type, extends\\(point\\) :: waypoint" \
>> +              "    Type point :: point" \
>> +              "    $real :: angle" \
>> +              "End Type waypoint"]
>> +set output_kfail [multi_line "type = Type waypoint" \
>> +"    Type point :: point" \
>> +"    $real :: angle" \
>> +"End Type waypoint"]
>> +set test "ptype wp"
>> +gdb_test_multiple $test %test {
>> +    -re "$output_pass\r\n$gdb_prompt $" {
>> +      pass "$test"
>> +    }
>> +    -re "$output_kfail\r\n$gdb_prompt $" {
>> +      kfail "gcc/49475" "$test"
>> +    }
>> +}
>> +
>> +set test "ptype wp%coo"
>> +gdb_test_multiple "$test" "$test" {
>> +    -re "$real \\(3\\)\r\n$gdb_prompt $" {
>> +      pass "$test"
>> +    }
>> +    -re "There is no member named coo.\r\n$gdb_prompt $" {
>> +      kfail "gcc/49475" "$test"
>> +    }
>> +}
>> +gdb_test "ptype wp%point%coo" "$real \\(3\\)"
>> +
>> +set test "p wp_vla(1)%coo"
>> +gdb_test_multiple "$test" "$test" {
>> +    -re " = \\(10, 12, 10\\)\r\n$gdb_prompt $" {
>> +      pass "$test"
>> +    }
>> +    -re "There is no member named coo.\r\n$gdb_prompt $" {
>> +      kfail "gcc/49475" "$test"
>> +    }
>> +}
>> +gdb_test "p wp_vla(1)%point%coo" " = \\(10, 12, 10\\)"
>> +gdb_test "p wp_vla(1)%point" " = \\( coo = \\(10, 12, 10\\) \\)"
>> +gdb_test "p wp_vla(1)" " = \\( point = \\( coo = \\(10, 12, 10\\) \\), angle = 101 \\)"
>> +
>> +gdb_test "whatis wp_vla" "type = Type waypoint \\(3\\)"
>> +set test "ptype wp_vla"
>> +gdb_test_multiple $test %test {
>> +    -re "$output_pass \\(3\\)\r\n$gdb_prompt $" {
>> +      pass "$test"
>> +    }
>> +    -re "$output_kfail \\(3\\)\r\n$gdb_prompt $" {
>> +      kfail "gcc/49475" "$test"
>> +    }
>> +}
>> +set test "ptype wp_vla(1)%coo"
>> +gdb_test_multiple "$test" "$test" {
>> +    -re "$real \\(3\\)\r\n$gdb_prompt $" {
>> +      pass "$test"
>> +    }
>> +    -re "There is no member named coo.\r\n$gdb_prompt $" {
>> +      kfail "gcc/49475" "$test"
>> +    }
>> +}
>> +gdb_test "ptype wp_vla(1)%point%coo" "$real \\(3\\)"
>> diff --git a/gdb/testsuite/gdb.fortran/oop-extend-type.f90 b/gdb/testsuite/gdb.fortran/oop-extend-type.f90
>> new file mode 100644
>> index 000000000000..1fe8611f4632
>> --- /dev/null
>> +++ b/gdb/testsuite/gdb.fortran/oop-extend-type.f90
>> @@ -0,0 +1,56 @@
>> +! Copyright 2018 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 testmod
>> +    implicit none
>> +    type :: point
>> +        real :: coo(3)
>> +    end type
>> +
>> +    type, extends(point) :: waypoint
>> +        real :: angle
>> +    end type
>> +
>> +end module
>> +
>> +program testprog
>> +    use testmod
>> +    implicit none
>> +
>> +    logical l
>> +    type(waypoint) :: wp
>> +    type(waypoint), allocatable :: wp_vla(:)
>> +
>> +    l = allocated(wp_vla)
>> +    allocate(wp_vla(3))               ! Before vla allocation
>> +
>> +    l = allocated(wp_vla)             ! After vla allocation
>> +    wp%angle = 100.00
>> +    wp%point%coo(:) = 1.00
>> +    wp%point%coo(2) = 2.00
>> +
>> +    wp_vla(1)%angle = 101.00
>> +    wp_vla(1)%point%coo(:) = 10.00
>> +    wp_vla(1)%point%coo(2) = 12.00
>> +    wp_vla(2)%angle = 102.00
>> +    wp_vla(2)%point%coo(:) = 20.00
>> +    wp_vla(2)%point%coo(2) = 22.00
>> +    wp_vla(3)%angle = 103.00
>> +    wp_vla(3)%point%coo(:) = 30.00
>> +    wp_vla(3)%point%coo(2) = 32.00
>> +
>> +    print *, wp, wp_vla               ! After value assignment
>> +
>> +end program
>> diff --git a/gdb/valops.c b/gdb/valops.c
>> index c45caefbf1e0..a34e74b2bee9 100644
>> --- a/gdb/valops.c
>> +++ b/gdb/valops.c
>> @@ -2163,6 +2163,12 @@ value_struct_elt (struct value **argp, struct value **args,
>>         if (v)
>>   	return v;
>>   
>> +      /* fortran: If it is not a field it is the
>> +         type name of an inherited structure */
>> +      v = search_struct_field (name, *argp, t, 1);
>> +      if (v)
>> +	return v;
>> +
>>         /* C++: If it was not found as a data field, then try to
>>            return it as a pointer to a method.  */
>>         v = search_struct_method (name, argp, args, 0,
>>
>