From: Janus Weil Date: Thu, 14 Aug 2008 21:15:59 +0000 (+0200) Subject: re PR fortran/36705 (Procedure pointers with attributes statements) X-Git-Tag: releases/gcc-4.4.0~3132 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=beb4bd6cf682a67cae7155eaebeea1b99229ab31;p=thirdparty%2Fgcc.git re PR fortran/36705 (Procedure pointers with attributes statements) 2008-08-14 Janus Weil PR fortran/36705 * symbol.c (check_conflict): Move conflict checks for (procedure,save) and (procedure,intent) to resolve_fl_procedure. * resolve.c (resolve_fl_procedure): Ditto. 2008-08-14 Janus Weil PR fortran/36705 * gfortran.dg/argument_checking_7.f90: Modified. * gfortran.dg/conflicts.f90: Modified. * gfortran.dg/proc_decl_1.f90: Modified. * gfortran.dg/proc_ptr_9.f90: New. From-SVN: r139116 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 3bdfb527f6b6..3ea6c32005cf 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2008-08-14 Janus Weil + + PR fortran/36705 + * symbol.c (check_conflict): Move conflict checks for (procedure,save) + and (procedure,intent) to resolve_fl_procedure. + * resolve.c (resolve_fl_procedure): Ditto. + 2008-08-09 Manuel Lopez-Ibanez PR 36901 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index c6a241a85458..994cb71151a5 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -7443,6 +7443,20 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) } } + if (sym->attr.save == SAVE_EXPLICIT && !sym->attr.proc_pointer) + { + gfc_error ("PROCEDURE attribute conflicts with SAVE attribute " + "in '%s' at %L", sym->name, &sym->declared_at); + return FAILURE; + } + + if (sym->attr.intent && !sym->attr.proc_pointer) + { + gfc_error ("PROCEDURE attribute conflicts with INTENT attribute " + "in '%s' at %L", sym->name, &sym->declared_at); + return FAILURE; + } + return SUCCESS; } diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 6b64bcf4353c..d564dd7782f1 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -417,12 +417,8 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) goto conflict; case FL_PROCEDURE: - if (attr->proc_pointer) - break; - a1 = gfc_code2string (flavors, attr->flavor); - a2 = save; - goto conflict; - + /* Conflicts between SAVE and PROCEDURE will be checked at + resolution stage, see "resolve_fl_procedure". */ case FL_VARIABLE: case FL_NAMELIST: default: @@ -618,8 +614,8 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) break; case FL_PROCEDURE: - if (!attr->proc_pointer) - conf2 (intent); + /* Conflicts with INTENT will be checked at resolution stage, + see "resolve_fl_procedure". */ if (attr->subroutine) { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 9a8f5f5b8769..94bde4826350 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2008-08-14 Janus Weil + + PR fortran/36705 + * gfortran.dg/argument_checking_7.f90: Modified. + * gfortran.dg/conflicts.f90: Modified. + * gfortran.dg/proc_decl_1.f90: Modified. + * gfortran.dg/proc_ptr_9.f90: New. + 2008-08-14 Paolo Carlini PR c++/34485 diff --git a/gcc/testsuite/gfortran.dg/argument_checking_7.f90 b/gcc/testsuite/gfortran.dg/argument_checking_7.f90 index 17f043a5a854..1c74fc58fd93 100644 --- a/gcc/testsuite/gfortran.dg/argument_checking_7.f90 +++ b/gcc/testsuite/gfortran.dg/argument_checking_7.f90 @@ -12,7 +12,7 @@ module cyclic character(len(y)-1) ouch integer i do i = 1, len(ouch) - ouch(i:i) = achar(ieor(iachar(x(i:i)),iachar(y(i:i)))) ! { dg-error " PROCEDURE attribute conflicts" } + ouch(i:i) = achar(ieor(iachar(x(i:i)),iachar(y(i:i)))) ! { dg-error "Syntax error in argument list" } end do end function ouch end module cyclic diff --git a/gcc/testsuite/gfortran.dg/conflicts.f90 b/gcc/testsuite/gfortran.dg/conflicts.f90 index b1b59f4ac4c0..1f10a65ceeda 100644 --- a/gcc/testsuite/gfortran.dg/conflicts.f90 +++ b/gcc/testsuite/gfortran.dg/conflicts.f90 @@ -2,16 +2,16 @@ ! Check for conflicts ! PR fortran/29657 -function f1() ! { dg-error "has no IMPLICIT type" } +function f1() ! { dg-error "PROCEDURE attribute conflicts with SAVE attribute" } implicit none - real, save :: f1 ! { dg-error "PROCEDURE attribute conflicts with SAVE attribute" } + real, save :: f1 f1 = 1.0 end function f1 -function f2() +function f2() ! { dg-error "PROCEDURE attribute conflicts with SAVE attribute" } implicit none real :: f2 - save f2 ! { dg-error "PROCEDURE attribute conflicts with SAVE attribute" } + save f2 f2 = 1.0 end function f2 diff --git a/gcc/testsuite/gfortran.dg/proc_decl_1.f90 b/gcc/testsuite/gfortran.dg/proc_decl_1.f90 index 3e7a3d18fb7f..219722f7a2da 100644 --- a/gcc/testsuite/gfortran.dg/proc_decl_1.f90 +++ b/gcc/testsuite/gfortran.dg/proc_decl_1.f90 @@ -53,13 +53,13 @@ program prog contains - subroutine foo(a,c) + subroutine foo(a,c) ! { dg-error "PROCEDURE attribute conflicts with INTENT attribute" } abstract interface subroutine b() bind(C) end subroutine b end interface procedure(b), bind(c,name="hjj") :: a ! { dg-error "may not have BIND.C. attribute with NAME" } - procedure(c),intent(in):: c ! { dg-error "PROCEDURE attribute conflicts with INTENT attribute" } + procedure(b),intent(in):: c end subroutine foo end program diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_9.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_9.f90 new file mode 100644 index 000000000000..22708b8f1a84 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_ptr_9.f90 @@ -0,0 +1,18 @@ +! { dg-do compile } +! +! PR fortran/36705 +! +! Contributed by Tobias Burnus + +save :: p +procedure() :: p +pointer :: p + +contains + +subroutine bar(x) + procedure(), intent(in) :: x + pointer :: x +end subroutine bar + +end