[Patch, Fortran] PR 63674: procedure pointer and non/pure procedure

[Janus Weil <janus at gcc dot gnu dot org>]

Hi all,

it's been a while since I have contributed to this list and to
gfortran, but it's good to see that you guys are still making a lot of
progress with this great compiler.

In any case, I recently found some time to prepare a small patch
related to my old pet (procedure pointers). It adds some diagnostics
for the PURE attribute.

Regtested on x86_64-unknown-linux-gnu. Ok for trunk?

Cheers,
Janus



2014-12-13  Janus Weil  <janus@gcc.gnu.org>

        PR fortran/63674
        * resolve.c (pure_function): Treat procedure-pointer components.
        (check_pure_function): New function.
        (resolve_function): Use it.
        (pure_subroutine): Return a bool to indicate success and modify
        arguments.
        (resolve_generic_s0,resolve_specific_s0,resolve_unknown_s): Use return
        value of 'pure_subroutine'.
        (resolve_ppc_call): Call 'pure_subroutine'.
        (resolve_expr_ppc): Call 'check_pure_function'.


2014-12-13  Janus Weil  <janus@gcc.gnu.org>

        PR fortran/63674
        * gfortran.dg/proc_ptr_comp_39.f90: New.

Attachment: pr63674.diff
Description: Text document

! { dg-do compile }
!
! PR 63674: [F03] procedure pointer and non/pure procedure
!
! Contributed by Valery Weber <valeryweber@hotmail.com>

program prog
  interface
    integer function nf()
    end function
    pure integer function pf()
    end function
    subroutine ns()
    end subroutine
    pure subroutine ps()
    end subroutine
  end interface
  type :: t
    procedure(nf), nopass, pointer :: nf => NULL()  ! non-pure function
    procedure(pf), nopass, pointer :: pf => NULL()  ! pure function
    procedure(ns), nopass, pointer :: ns => NULL()  ! non-pure subroutine
    procedure(ps), nopass, pointer :: ps => NULL()  ! pure subroutine
  end type
contains
  pure integer function eval(a)
    type(t), intent(in) :: a
    eval = a%pf()
    eval = a%nf()   ! { dg-error "Reference to non-PURE function" }
    call a%ps()
    call a%ns()     ! { dg-error "is not PURE" }
  end function
end