From 62d8c84c97e2b61bf123f012b53bac350c753703 Mon Sep 17 00:00:00 2001 From: burnus Date: Thu, 21 Oct 2010 06:15:30 +0000 Subject: [PATCH] 2010-10-21 Tobias Burnus PR fortran/46100 * expr.c (gfc_check_vardef_context): Treat pointer functions as variables. 2010-10-21 Tobias Burnus PR fortran/46100 * gfortran.dg/ptr-func-1.f90: New. * gfortran.dg/ptr-func-2.f90: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165749 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 6 ++++++ gcc/fortran/expr.c | 13 ++++++++++++- gcc/testsuite/ChangeLog | 6 ++++++ gcc/testsuite/gfortran.dg/ptr-func-1.f90 | 24 ++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/ptr-func-2.f90 | 24 ++++++++++++++++++++++++ 5 files changed, 72 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/ptr-func-1.f90 create mode 100644 gcc/testsuite/gfortran.dg/ptr-func-2.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 1e10747c6f5..37f4b16ef84 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2010-10-21 Tobias Burnus + + PR fortran/46100 + * expr.c (gfc_check_vardef_context): Treat pointer functions + as variables. + 2010-10-20 Jerry DeLisle PR fortran/46079 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 57116344666..ef516a4442d 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -4316,7 +4316,18 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, const char* context) symbol_attribute attr; gfc_ref* ref; - if (e->expr_type != EXPR_VARIABLE) + if (!pointer && e->expr_type == EXPR_FUNCTION + && e->symtree->n.sym->result->attr.pointer) + { + if (!(gfc_option.allow_std & GFC_STD_F2008)) + { + if (context) + gfc_error ("Fortran 2008: Pointer functions in variable definition" + " context (%s) at %L", context, &e->where); + return FAILURE; + } + } + else if (e->expr_type != EXPR_VARIABLE) { if (context) gfc_error ("Non-variable expression in variable definition context (%s)" diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 5abf927bf9a..e388ac152e4 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2010-10-21 Tobias Burnus + + PR fortran/46100 + * gfortran.dg/ptr-func-1.f90: New. + * gfortran.dg/ptr-func-2.f90: New. + 2010-10-20 Jakub Jelinek PR tree-optimization/45919 diff --git a/gcc/testsuite/gfortran.dg/ptr-func-1.f90 b/gcc/testsuite/gfortran.dg/ptr-func-1.f90 new file mode 100644 index 00000000000..b7c1fc93da2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/ptr-func-1.f90 @@ -0,0 +1,24 @@ +! { dg-do compile } +! { dg-options "-std=f2008 -fall-intrinsics" } +! +! PR fortran/46100 +! +! Pointer function as definable actual argument +! - a Fortran 2008 feature +! +integer, target :: tgt +call one (two ()) +if (tgt /= 774) call abort () +contains + subroutine one (x) + integer, intent(inout) :: x + if (x /= 34) call abort () + x = 774 + end subroutine one + function two () + integer, pointer :: two + two => tgt + two = 34 + end function two +end + diff --git a/gcc/testsuite/gfortran.dg/ptr-func-2.f90 b/gcc/testsuite/gfortran.dg/ptr-func-2.f90 new file mode 100644 index 00000000000..8275f14c789 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/ptr-func-2.f90 @@ -0,0 +1,24 @@ +! { dg-do compile } +! { dg-options "-std=f2003 -fall-intrinsics" } +! +! PR fortran/46100 +! +! Pointer function as definable actual argument +! - a Fortran 2008 feature +! +integer, target :: tgt +call one (two ()) ! { dg-error "Fortran 2008: Pointer functions" } +if (tgt /= 774) call abort () +contains + subroutine one (x) + integer, intent(inout) :: x + if (x /= 34) call abort () + x = 774 + end subroutine one + function two () + integer, pointer :: two + two => tgt + two = 34 + end function two +end + -- 2.11.4.GIT