Commit 3dcc3ef2 by Tobias Burnus Committed by Tobias Burnus

re PR fortran/37504 (Wrongly rejects: unprotected_pointer => protected_pointer)

2008-09-25  Tobias Burnus  <burnus@net-b.de>

        PR fortran/37504
        * expr.c (gfc_check_pointer_assign): Allow assignment of
        protected pointers.
        * match.c (gfc_match_assignment,gfc_match_pointer_assignment):
        Remove unreachable code.

2008-09-25  Tobias Burnus  <burnus@net-b.de>

        PR fortran/37504
        * gfortran.dg/protected_7.f90: New test.

From-SVN: r140663
parent 116612b9
2008-09-25 Tobias Burnus <burnus@net-b.de>
PR fortran/37504
* expr.c (gfc_check_pointer_assign): Allow assignment of
protected pointers.
* match.c (gfc_match_assignment,gfc_match_pointer_assignment):
Remove unreachable code.
2008-09-24 Tobias Burnus <burnus@net-b.de> 2008-09-24 Tobias Burnus <burnus@net-b.de>
* options.c (set_default_std_flags,gfc_init_options): * options.c (set_default_std_flags,gfc_init_options):
......
...@@ -3076,7 +3076,8 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) ...@@ -3076,7 +3076,8 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
return FAILURE; return FAILURE;
} }
if (attr.is_protected && attr.use_assoc) if (attr.is_protected && attr.use_assoc
&& !(attr.pointer || attr.proc_pointer))
{ {
gfc_error ("Pointer assignment target has PROTECTED " gfc_error ("Pointer assignment target has PROTECTED "
"attribute at %L", &rvalue->where); "attribute at %L", &rvalue->where);
......
...@@ -1293,15 +1293,6 @@ gfc_match_assignment (void) ...@@ -1293,15 +1293,6 @@ gfc_match_assignment (void)
return MATCH_NO; return MATCH_NO;
} }
if (lvalue->symtree->n.sym->attr.is_protected
&& lvalue->symtree->n.sym->attr.use_assoc)
{
gfc_current_locus = old_loc;
gfc_free_expr (lvalue);
gfc_error ("Setting value of PROTECTED variable at %C");
return MATCH_ERROR;
}
rvalue = NULL; rvalue = NULL;
m = gfc_match (" %e%t", &rvalue); m = gfc_match (" %e%t", &rvalue);
if (m != MATCH_YES) if (m != MATCH_YES)
...@@ -1353,14 +1344,6 @@ gfc_match_pointer_assignment (void) ...@@ -1353,14 +1344,6 @@ gfc_match_pointer_assignment (void)
if (m != MATCH_YES) if (m != MATCH_YES)
goto cleanup; goto cleanup;
if (lvalue->symtree->n.sym->attr.is_protected
&& lvalue->symtree->n.sym->attr.use_assoc)
{
gfc_error ("Assigning to a PROTECTED pointer at %C");
m = MATCH_ERROR;
goto cleanup;
}
new_st.op = EXEC_POINTER_ASSIGN; new_st.op = EXEC_POINTER_ASSIGN;
new_st.expr = lvalue; new_st.expr = lvalue;
new_st.expr2 = rvalue; new_st.expr2 = rvalue;
......
2008-09-25 Tobias Burnus <burnus@net-b.de>
PR fortran/37504
* gfortran.dg/protected_7.f90: New test.
2008-09-24 Steve Ellcey <sje@cup.hp.com> 2008-09-24 Steve Ellcey <sje@cup.hp.com>
* gcc.dg/vect/O3-vect-pr34223.c: Check vect_int_mult. * gcc.dg/vect/O3-vect-pr34223.c: Check vect_int_mult.
......
! { dg-do compile }
! PR fortran/37504
!
module m
implicit none
integer, pointer, protected :: protected_pointer
integer, target, protected :: protected_target
end module m
program p
use m
implicit none
integer, pointer :: unprotected_pointer
! The next two lines should be rejected; see PR 37513 why
! we get such a strange error message.
protected_pointer => unprotected_pointer ! { dg-error "only allowed in specification part" }
protected_pointer = unprotected_pointer ! { dg-error "only allowed in specification part" }
unprotected_pointer => protected_target ! { dg-error "target has PROTECTED attribute" }
unprotected_pointer => protected_pointer ! OK
end program p
! { dg-final { cleanup-modules "m" } }
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment