OSDN Git Service

2008-09-25 Tobias Burnus <burnus@net-b.de>
authorburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 25 Sep 2008 15:01:16 +0000 (15:01 +0000)
committerburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 25 Sep 2008 15:01:16 +0000 (15:01 +0000)
        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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@140663 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/expr.c
gcc/fortran/match.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/protected_7.f90 [new file with mode: 0644]

index c8301f6..16ed9e9 100644 (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):
index e15412a..7b741b8 100644 (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);
index f7ff9bb..c8fd30d 100644 (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;
index 0be7f7d..2941ac9 100644 (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.
diff --git a/gcc/testsuite/gfortran.dg/protected_7.f90 b/gcc/testsuite/gfortran.dg/protected_7.f90
new file mode 100644 (file)
index 0000000..0325a49
--- /dev/null
@@ -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" } }