2008-10-04 Paul Thomas <pault@gcc.gnu.org>

[pf3gnuchains/gcc-fork.git] / gcc / fortran / match.c

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 42fe794..c8fd30d 100644 (file)
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -27,6 +27,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "parse.h"
 
 int gfc_matching_procptr_assignment = 0;
+bool gfc_matching_prefix = false;
 
 /* For debugging and diagnostic purposes.  Return the textual representation
    of the intrinsic operator OP.  */
@@ -1292,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)
@@ -1352,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;
@@ -2508,6 +2492,49 @@ done:
 }
 
 
+/* Match the call of a type-bound procedure, if CALL%var has already been 
+   matched and var found to be a derived-type variable.  */
+
+static match
+match_typebound_call (gfc_symtree* varst)
+{
+  gfc_symbol* var;
+  gfc_expr* base;
+  match m;
+
+  var = varst->n.sym;
+
+  base = gfc_get_expr ();
+  base->expr_type = EXPR_VARIABLE;
+  base->symtree = varst;
+  base->where = gfc_current_locus;
+  gfc_set_sym_referenced (varst->n.sym);
+  
+  m = gfc_match_varspec (base, 0, true);
+  if (m == MATCH_NO)
+    gfc_error ("Expected component reference at %C");
+  if (m != MATCH_YES)
+    return MATCH_ERROR;
+
+  if (gfc_match_eos () != MATCH_YES)
+    {
+      gfc_error ("Junk after CALL at %C");
+      return MATCH_ERROR;
+    }
+
+  if (base->expr_type != EXPR_COMPCALL)
+    {
+      gfc_error ("Expected type-bound procedure reference at %C");
+      return MATCH_ERROR;
+    }
+
+  new_st.op = EXEC_COMPCALL;
+  new_st.expr = base;
+
+  return MATCH_YES;
+}
+
+
 /* Match a CALL statement.  The tricky part here are possible
    alternate return specifiers.  We handle these by having all
    "subroutines" actually return an integer via a register that gives
@@ -2540,9 +2567,17 @@ gfc_match_call (void)
 
   sym = st->n.sym;
 
-  /* If it does not seem to be callable...  */
+  /* If this is a variable of derived-type, it probably starts a type-bound
+     procedure call.  */
+  if (sym->attr.flavor != FL_PROCEDURE && sym->ts.type == BT_DERIVED)
+    return match_typebound_call (st);
+
+  /* If it does not seem to be callable (include functions so that the
+     right association is made.  They are thrown out in resolution.)
+     ...  */
   if (!sym->attr.generic
-       && !sym->attr.subroutine)
+       && !sym->attr.subroutine
+       && !sym->attr.function)
     {
       if (!(sym->attr.external && !sym->attr.referenced))
        {