OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Tobias Burnus 2008-09-25 17:01:16 +02:00 committed by Tobias Burnus
parent 116612b994
commit 3dcc3ef2a1
5 changed files with 37 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/fortran/ChangeLog
View File

@ -1,3 +1,11 @@
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>
* options.c (set_default_std_flags,gfc_init_options):

3
gcc/fortran/expr.c
View File

@ -3076,7 +3076,8 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
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 "
"attribute at %L", &rvalue->where);

17
gcc/fortran/match.c
View File

@ -1293,15 +1293,6 @@ gfc_match_assignment (void)
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;
m = gfc_match (" %e%t", &rvalue);
if (m != MATCH_YES)
@ -1353,14 +1344,6 @@ gfc_match_pointer_assignment (void)
if (m != MATCH_YES)
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.expr = lvalue;
new_st.expr2 = rvalue;

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
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>
* gcc.dg/vect/O3-vect-pr34223.c: Check vect_int_mult.

22
gcc/testsuite/gfortran.dg/protected_7.f90 Normal file
View File

@ -0,0 +1,22 @@
! { 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" } }