Bug 63921 - [F08] pointer function as lvalue doesn't work when the function is a type bound function
Summary: [F08] pointer function as lvalue doesn't work when the function is a type bou...
Status: RESOLVED FIXED
Alias: None
Product: gcc
Classification: Unclassified
Component: fortran (show other bugs)
Version: 4.9.2
: P3 normal
Target Milestone: ---
Assignee: Not yet assigned to anyone
URL:
Keywords:
Depends on:
Blocks: F2008
  Show dependency treegraph
 
Reported: 2014-11-17 18:31 UTC by mirco
Modified: 2015-09-28 21:25 UTC (History)
2 users (show)

See Also:
Host:
Target:
Build:
Known to work:
Known to fail:
Last reconfirmed: 2014-12-07 00:00:00


Attachments
Source code useful to explain the bug (693 bytes, text/x-fortran)
2014-11-17 18:31 UTC, mirco
Details

Note You need to log in before you can comment on or make changes to this bug.
Description mirco 2014-11-17 18:31:01 UTC
Created attachment 34006 [details]
Source code useful to explain the bug

If I try to use a type bounded function as lvalue 
the compiler throw this error

!...COMPILER VERSION............................................................
Using built-in specs.
COLLECT_GCC=/opt/gcc/5.0/bin/gfortran
COLLECT_LTO_WRAPPER=/opt/gcc/5.0/libexec/gcc/x86_64-unknown-linux-gnu/4.9.2/lto-wrapper
Target: x86_64-unknown-linux-gnu
Configured with: ../src/configure --prefix /opt/gcc/5.0/
Thread model: posix
gcc version 4.9.2 (GCC) 
!...............................................................................

!...COMPILER OUTPUT.............................................................
lvalue.f90:110.2:

  STENCIL%JMP( 1, 1 ) = 10.0d0 + STENCIL%JMP( 1, 1 )
  1
Error: 'lvalue_jmp' in variable definition context (assignment) at (1) is not a variable
make: *** [test.x] Error 1
!...............................................................................

!...COMPILING COMMAND...........................................................
gfortran -save-temps lvalue.f90 -o test.x
!...............................................................................


If I want to modify the data pointed by the function I need to use a temporary variable.

!... BUG ......................................................................
  ...
  !...Running version with temporary pointer
  !real_tmp_ptr => STENCIL%JMP( 1, 1 )
  !real_tmp_ptr = 10.0d0 + STENCIL%JMP( 1, 1 )

  !...Not running version
  STENCIL%JMP( 1, 1 ) = 10.0d0 + STENCIL%JMP( 1, 1 )
  ...
!..............................................................................

Mirco
Comment 1 Dominique d'Humieres 2014-12-07 13:35:08 UTC
Am I correct to understand that you are referring to C602 in

6.2 Variable
R602 variable is designator
              or expr
C601 (R602) designator shall not be a constant or a subobject of a constant.
C602 (R602) expr shall be a reference to a function that has a pointer result.
1 A variable is either the data object denoted by designator or the target of expr.
...

? If yes, then I can confirm this PR.
Comment 2 mirco 2014-12-07 16:22:57 UTC
(In reply to Dominique d'Humieres from comment #1)
> Am I correct to understand that you are referring to C602 in
> 
> 6.2 Variable
> R602 variable is designator
>               or expr
> C601 (R602) designator shall not be a constant or a subobject of a constant.
> C602 (R602) expr shall be a reference to a function that has a pointer
> result.
> 1 A variable is either the data object denoted by designator or the target
> of expr.
> ...
> 
> ? If yes, then I can confirm this PR.

Yes, it is exactly what I mean. 
Thank you for your detailed explanation.

Mirco
Comment 3 Dominique d'Humieres 2015-08-10 22:55:03 UTC
Reset the importance to normal: as for today there are 854 open PRs and several hundreds of them are more or as 'critical' than this one.

If this PR is really critical for you, you should consider to fix it yourself (or hire someone to do it for you).
Comment 4 Paul Thomas 2015-09-05 21:14:28 UTC
(In reply to Dominique d'Humieres from comment #3)
> Reset the importance to normal: as for today there are 854 open PRs and
> several hundreds of them are more or as 'critical' than this one.
> 
> If this PR is really critical for you, you should consider to fix it
> yourself (or hire someone to do it for you).

Dear Mirco,

You will be happy to know that I have a patch for pointer function assignment, which fixes your problem. It will be submitted tomorrow.

Dominique tested the patch today and recalled your problem report. I have recast your testcase and it appears below. I might not use this in the testsuite since it largely duplicates the one that I had written. However, the line  STENCIL%JMP (1, 1 ) = 10.0d0 + STENCIL%JMP (1, 1 ) is neat and I will probably add something like it together with an attribution to you.

Dominique also reminded me that PR40054 covers this missing feature from gfortran.

Thanks for the report.

Paul

! { dg-do run }
!
! Testcase for pointer function assignment from PR63921
! Contributed by Mirco Valentini  <mirco.valentini@polimi.it>
!
MODULE grid
  IMPLICIT NONE
  PRIVATE
  REAL(KIND=8), DIMENSION(100,100), TARGET :: WORKSPACE
  TYPE, PUBLIC :: grid_t
    REAL(KIND=8), DIMENSION(:,:), POINTER :: P => NULL ()
  END TYPE
  PUBLIC :: INIT
CONTAINS
  SUBROUTINE INIT( DAT )
    IMPLICIT NONE
    TYPE(grid_t), INTENT(INOUT) :: DAT
    INTEGER :: I, J
    DAT%P => WORKSPACE
    DO I = 1, 100
      DO J = 1, 100
        DAT%P(I,J) = REAL ((I - 1)*100 + J - 1 )
      END DO
    ENDDO
 END SUBROUTINE INIT
END MODULE grid

MODULE subgrid
  USE :: grid, ONLY: grid_t
  IMPLICIT NONE
  PRIVATE
  TYPE, PUBLIC :: subgrid_t
    INTEGER, DIMENSION(4) :: range
    CLASS(grid_t), POINTER    :: grd => NULL ()
  CONTAINS
    PROCEDURE, PASS :: INIT => LVALUE_INIT
    PROCEDURE, PASS :: JMP => LVALUE_JMP
  END TYPE
CONTAINS
  SUBROUTINE LVALUE_INIT(HOBJ, P, D  )
    IMPLICIT NONE
    CLASS(subgrid_t), INTENT(INOUT) :: HOBJ
    TYPE(grid_t), POINTER, INTENT(IN)    :: P
    INTEGER, DIMENSION(4),   INTENT(IN)    :: D
    HOBJ%range = D
    HOBJ%grd => P
  END SUBROUTINE LVALUE_INIT

  FUNCTION LVALUE_JMP(HOBJ, I, J ) RESULT(P)
    IMPLICIT NONE
    CLASS(subgrid_t), INTENT(INOUT) :: HOBJ
    INTEGER, INTENT(IN) :: I, J
    REAL(KIND=8), POINTER :: P
    P => HOBJ%grd%P( HOBJ%range(1) + I - 1, HOBJ%range(3) + J - 1 )
  END FUNCTION LVALUE_JMP
END MODULE subgrid

PROGRAM test_lvalue
  USE :: grid
  USE :: subgrid
  IMPLICIT NONE
  TYPE(grid_t), POINTER :: GRID
  TYPE(subgrid_t) :: STENCIL
  REAL(KIND=8), POINTER :: real_tmp_ptr
  REAL(KIND=8) :: old_val
  ALLOCATE (GRID)
  CALL INIT (GRID)
  CALL STENCIL%INIT (GRID, [50, 52, 50, 53 ])
  old_val = STENCIL%JMP (1, 1 )

  ! Workaround
  !real_tmp_ptr => STENCIL%JMP( 1, 1 )
  !real_tmp_ptr = 10.0d0 + STENCIL%JMP( 1, 1 )

  ! This failed
  STENCIL%JMP (1, 1 ) = 10.0d0 + STENCIL%JMP (1, 1 )
  if (STENCIL%JMP (1, 1 ) .ne. old_val + 10.0d0) call abort
END PROGRAM test_lvalue
Comment 5 mirco 2015-09-06 10:03:33 UTC
Thank you Paul, 

I was trying to follow the Dominique's suggestion and to fix the problem by myself but it was the first time I examined the gfortran's code, and I was still trying to understand its structure.  I'm looking forward to see your patch in order to better understand gfortran.

Best regards

Mirco
Comment 6 Paul Thomas 2015-09-28 21:19:10 UTC
Author: pault
Date: Mon Sep 28 21:18:38 2015
New Revision: 228222

URL: https://gcc.gnu.org/viewcvs?rev=228222&root=gcc&view=rev
Log:
2015-09-28  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/40054
	PR fortran/63921
	* decl.c (get_proc_name): Return if statement function is
	found.
	* expr.c (gfc_check_vardef_context): Add error return for
	derived type expression lacking the derived type itself.
	* match.c (gfc_match_ptr_fcn_assign): New function.
	* match.h : Add prototype for gfc_match_ptr_fcn_assign.
	* parse.c : Add static flag 'in_specification_block'.
	(decode_statement): If in specification block match a statement
	function, then, if no error arising from statement function
	matching, try to match pointer function assignment.
	(parse_interface): Set 'in_specification_block' on exiting from
	parse_spec.
	(parse_spec): Set and then reset 'in_specification_block'.
	(gfc_parse_file): Set 'in_specification_block'.
	* resolve.c (get_temp_from_expr): Extend to include functions
	and array constructors as rvalues..
	(resolve_ptr_fcn_assign): New function.
	(gfc_resolve_code): Call it on finding a pointer function as an
	lvalue. If valid or on error, go back to start of resolve_code.
	* symbol.c (gfc_add_procedure): Add a sentence to the error to
	flag up the ambiguity between a statement function and pointer
	function assignment at the end of the specification block.

2015-09-28  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/40054
	PR fortran/63921
	* gfortran.dg/fmt_tab_1.f90: Change from run to compile and set
	standard as legacy.
	* gfortran.dg/fmt_tab_2.f90: Add extra tab error.
	* gfortran.dg/function_types_3.f90: Change error message to
	"Type inaccessible...."
	* gfortran.dg/ptr_func_assign_1.f08: New test.
	* gfortran.dg/ptr_func_assign_2.f08: New test.

2015-09-25  Mikael Morin  <mikael.morin@sfr.fr>

	PR fortran/40054
	PR fortran/63921
	* gfortran.dg/ptr_func_assign_3.f08: New test.
	* gfortran.dg/ptr_func_assign_4.f08: New test.

Added:
    trunk/gcc/testsuite/gfortran.dg/ptr_func_assign_1.f08
    trunk/gcc/testsuite/gfortran.dg/ptr_func_assign_2.f08
    trunk/gcc/testsuite/gfortran.dg/ptr_func_assign_3.f08
    trunk/gcc/testsuite/gfortran.dg/ptr_func_assign_4.f08
Modified:
    trunk/gcc/fortran/ChangeLog
    trunk/gcc/fortran/decl.c
    trunk/gcc/fortran/expr.c
    trunk/gcc/fortran/match.c
    trunk/gcc/fortran/match.h
    trunk/gcc/fortran/parse.c
    trunk/gcc/fortran/resolve.c
    trunk/gcc/fortran/symbol.c
    trunk/gcc/testsuite/ChangeLog
    trunk/gcc/testsuite/gfortran.dg/fmt_tab_1.f90
    trunk/gcc/testsuite/gfortran.dg/fmt_tab_2.f90
    trunk/gcc/testsuite/gfortran.dg/function_types_3.f90
Comment 7 Paul Thomas 2015-09-28 21:25:47 UTC
Dear Mirco,

Your testcase got rather subsumed but thanks anyway... it still works :-)

Fixed on trunk.

Paul