gcc/fortran/expr.c

259 /* Given an expression pointer, return a copy of the expression.  This
293       /* Copy the values of any pointer components of p->value.  */
788    argument list with a NULL pointer terminating the list.  */
3107   /* See if this is the component or subcomponent of a pointer.  */
3108   has_pointer = sym->attr.pointer;
3110     if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer)
3200       && rvalue->expr_type == EXPR_FUNCTION && gfc_expr_attr (rvalue).pointer)
3336 /* Check that a pointer assignment is OK.  We first check lvalue, and
3359       gfc_error ("%qs in the pointer assignment at %L cannot be an "
3388 			       "for %qs in pointer assignment at %L",
3436   /* F2008, C723 (pointer) and C726 (proc-pointer); for PURE also C1283.  */
3450   /* Checks on rvalue for procedure pointer assignments.  */
3465 	  gfc_error ("Invalid procedure pointer assignment at %L",
3490 			       "in procedure pointer assignment at %L",
3499 		     "in procedure pointer assignment at %L",
3509 			 "in procedure pointer assignment at %L",
3515 			      "is invalid in procedure pointer assignment "
3521 	      gfc_error ("Intrinsic %qs at %L is invalid in procedure pointer "
3530 		     "in procedure pointer assignment at %L",
3552 	      gfc_error ("Mismatch in the procedure pointer assignment "
3623 	  gfc_error ("Interface mismatch in procedure pointer assignment "
3632 	  gfc_error ("Procedure pointer target %qs at %L must be either an "
3649 	gfc_error ("Data-pointer-object at %L must be unlimited "
3654 	gfc_error ("Different types in pointer assignment at %L; "
3663       gfc_error ("Different kind type parameters in pointer "
3670       gfc_error ("Different ranks in pointer assignment at %L", &lvalue->where);
3684 	 large as the pointer assigned to it is.  */
3690 		     " pointer (%ld < %ld) at %L",
3718       bool t = gfc_check_same_strlen (lvalue, rvalue, "pointer assignment");
3728   if (rvalue->expr_type == EXPR_FUNCTION && !attr.pointer)
3730       gfc_error ("Target expression in pointer assignment "
3731 		 "at %L must deliver a pointer result",
3736   if (!attr.target && !attr.pointer)
3745       gfc_error ("Bad target in pointer assignment in PURE "
3760       && !(attr.pointer || attr.proc_pointer))
3781   /* Warn if it is the LHS pointer may lives longer than the RHS target.  */
3785       && !attr.pointer && !rvalue->symtree->n.sym->attr.host_assoc
3816 		     "Pointer at %L in pointer assignment might outlive the "
3817 		     "pointer target", &lvalue->where);
3832   bool pointer, proc_pointer;
3853       pointer = comp->ts.type == BT_CLASS &&  CLASS_DATA (comp)
3854 		? CLASS_DATA (comp)->attr.class_pointer : comp->attr.pointer;
3859       pointer = sym->ts.type == BT_CLASS &&  CLASS_DATA (sym)
3860 		? CLASS_DATA (sym)->attr.class_pointer : sym->attr.pointer;
3864   if (pointer || proc_pointer)
3885   if (pointer && rvalue->expr_type != EXPR_NULL)
3887       /* F08:C461. Additional checks for pointer initialization.  */
3896       if (!attr.target || attr.pointer)
3921       /* F08:C1220. Additional checks for procedure pointer initialization.  */
3925 	  gfc_error ("Procedure pointer initialization target at %L "
3926 		     "may not be a procedure pointer", &rvalue->where);
3947         if (!c->attr.pointer
3950 	if (c->attr.pointer && c->initializer)
3995 	      && !comp->attr.pointer && !comp->attr.proc_pointer)
4298 /* Determine if an expression is a procedure pointer component and return
4321 /* Determine if an expression is a procedure pointer component.  */
4457    selection, or pointer component selection. (F2008, 2.4.7)  */
4492         else if (comp->attr.pointer || comp->attr.allocatable)
4581 /* Check whether the expression has an pointer component.
4582    Being itself a pointer does not count.  */
4651 		&& part_ref->u.c.component->attr.pointer)
4654 		&& (sym->attr.pointer
4775    (F2008, 16.6.7) or pointer association context (F2008, 16.6.8).
4785 gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
4808   if (!pointer && e->expr_type == EXPR_FUNCTION && attr.pointer)
4826   if (!pointer && sym->attr.flavor == FL_PARAMETER)
4833   if (!pointer && sym->attr.flavor != FL_VARIABLE
4843   /* Find out whether the expr is a pointer; this also means following
4845   is_pointer = (attr.pointer || attr.proc_pointer);
4846   if (pointer && !is_pointer)
4849 	gfc_error ("Non-POINTER in pointer association context (%s)"
4881      component of sub-component of a pointer; we need to distinguish
4882      assignment to a pointer component from pointer-assignment to a pointer
4887 		  ? CLASS_DATA (sym)->attr.class_pointer : sym->attr.pointer;
4892       if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer)
4895 	  if (!pointer)
4901       if (pointer && is_pointer)
4904 	    gfc_error ("Dummy argument %qs with INTENT(IN) in pointer"
4909       if (!pointer && !is_pointer && !sym->attr.pointer)
4922       if (pointer && is_pointer)
4926 		       " pointer association context (%s) at %L",
4930       if (!pointer && !is_pointer)
4942   if (!pointer && !own_scope && gfc_pure (NULL) && gfc_impure_variable (sym))
4951   if (!pointer && context && gfc_implicit_pure (NULL)
4970   if (!pointer && sym->assoc)
5016       if (!gfc_check_vardef_context (assoc->target, pointer, false, false, NULL))