re PR fortran/44446 (Error with protected pocedure pointer)

2010-06-07  Tobias Burnus  <burnus@net-b.de>

        PR fortran/44446
        * symbol.c (check_conflict): Move protected--external/procedure
        check ...
        * resolve.c (resolve_select_type): ... to the resolution stage.

2010-06-07  Tobias Burnus  <burnus@net-b.de>

        PR fortran/44446
        * gfortran.dg/proc_ptr_27.f90: New.

From-SVN: r160424
This commit is contained in:
Tobias Burnus 2010-06-08 08:37:32 +02:00 committed by Tobias Burnus
parent af88c58fb8
commit c064bf1cef
5 changed files with 44 additions and 2 deletions

View File

@ -1,3 +1,9 @@
2010-06-08 Tobias Burnus <burnus@net-b.de>
PR fortran/44446
* symbol.c (check_conflict): Move protected--external/procedure check ...
* resolve.c (resolve_select_type): ... to the resolution stage.
2010-06-07 Tobias Burnus <burnus@net-b.de>
* options.c (gfc_handle_option): Fix -fno-recursive.

View File

@ -11311,6 +11311,19 @@ resolve_symbol (gfc_symbol *sym)
}
}
if (sym->attr.is_protected && !sym->attr.proc_pointer
&& (sym->attr.procedure || sym->attr.external))
{
if (sym->attr.external)
gfc_error ("PROTECTED attribute conflicts with EXTERNAL attribute "
"at %L", &sym->declared_at);
else
gfc_error ("PROCEDURE attribute conflicts with PROTECTED attribute "
"at %L", &sym->declared_at);
return;
}
if (sym->attr.flavor == FL_DERIVED && resolve_fl_derived (sym) == FAILURE)
return;

View File

@ -567,7 +567,6 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
}
conf (is_protected, intrinsic)
conf (is_protected, external)
conf (is_protected, in_common)
conf (asynchronous, intrinsic)
@ -587,7 +586,6 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf (procedure, dimension)
conf (procedure, codimension)
conf (procedure, intrinsic)
conf (procedure, is_protected)
conf (procedure, target)
conf (procedure, value)
conf (procedure, volatile_)

View File

@ -1,3 +1,8 @@
2010-06-07 Tobias Burnus <burnus@net-b.de>
PR fortran/44446
* gfortran.dg/proc_ptr_27.f90: New.
2010-06-07 Jason Merrill <jason@redhat.com>
PR c++/44366

View File

@ -0,0 +1,20 @@
! { dg-do compile }
!
! PR fortran/44446
!
! Contributed by Marco Restelli.
!
! Procedure pointer with PROTECTED was wrongly rejected.
!
module m
implicit none
abstract interface
pure function i_f(x) result(y)
real, intent(in) :: x
real :: y
end function i_f
end interface
procedure(i_f), pointer, protected :: p_f => null()
end module m
! { dg-final { cleanup-modules "m" } }