View | Details | Raw Unified | Return to bug 48279
Collapse All | Expand All | Context: (Patch / File /
)

(-)a/gcc/fortran/expr.c (-5 / +13 lines)
 Lines 4309-4323   gfc_build_intrinsic_call (const char* name, locus where, unsigned numarg, ...) Link Here 
4309
gfc_try
4309
gfc_try
4310
gfc_check_vardef_context (gfc_expr* e, bool pointer, const char* context)
4310
gfc_check_vardef_context (gfc_expr* e, bool pointer, const char* context)
4311
{
4311
{
4312
  gfc_symbol* sym;
4312
  gfc_symbol* sym = NULL;
4313
  bool is_pointer;
4313
  bool is_pointer;
4314
  bool check_intentin;
4314
  bool check_intentin;
4315
  bool ptr_component;
4315
  bool ptr_component;
4316
  symbol_attribute attr;
4316
  symbol_attribute attr;
4317
  gfc_ref* ref;
4317
  gfc_ref* ref;
4318
4318
4319
  if (e->expr_type == EXPR_VARIABLE)
4320
    {
4321
      gcc_assert (e->symtree);
4322
      sym = e->symtree->n.sym;
4323
    }
4324
  else if (e->expr_type == EXPR_FUNCTION)
4325
    {
4326
      gcc_assert (e->symtree);
4327
      sym = e->value.function.esym ? e->value.function.esym : e->symtree->n.sym;
4328
    }
4329
4319
  if (!pointer && e->expr_type == EXPR_FUNCTION
4330
  if (!pointer && e->expr_type == EXPR_FUNCTION
4320
      && e->symtree->n.sym->result->attr.pointer)
4331
      && sym->result->attr.pointer)
4321
    {
4332
    {
4322
      if (!(gfc_option.allow_std & GFC_STD_F2008))
4333
      if (!(gfc_option.allow_std & GFC_STD_F2008))
4323
	{
4334
	{
 Lines 4335-4343   gfc_check_vardef_context (gfc_expr* e, bool pointer, const char* context) Link Here 
4335
      return FAILURE;
4346
      return FAILURE;
4336
    }
4347
    }
4337
4348
4338
  gcc_assert (e->symtree);
4339
  sym = e->symtree->n.sym;
4340
4341
  if (!pointer && sym->attr.flavor == FL_PARAMETER)
4349
  if (!pointer && sym->attr.flavor == FL_PARAMETER)
4342
    {
4350
    {
4343
      if (context)
4351
      if (context)
(-)a/gcc/fortran/interface.c (-13 / +22 lines)
 Lines 1098-1118   check_interface0 (gfc_interface *p, const char *interface_name) Link Here 
1098
  gfc_interface *psave, *q, *qlast;
1098
  gfc_interface *psave, *q, *qlast;
1099
1099
1100
  psave = p;
1100
  psave = p;
1101
  /* Make sure all symbols in the interface have been defined as
1102
     functions or subroutines.  */
1103
  for (; p; p = p->next)
1101
  for (; p; p = p->next)
1104
    if ((!p->sym->attr.function && !p->sym->attr.subroutine)
1102
    {
1105
	|| !p->sym->attr.if_source)
1103
      /* Make sure all symbols in the interface have been defined as
1106
      {
1104
	 functions or subroutines.  */
1107
	if (p->sym->attr.external)
1105
      if ((!p->sym->attr.function && !p->sym->attr.subroutine)
1108
	  gfc_error ("Procedure '%s' in %s at %L has no explicit interface",
1106
	  || !p->sym->attr.if_source)
1109
		     p->sym->name, interface_name, &p->sym->declared_at);
1107
	{
1110
	else
1108
	  if (p->sym->attr.external)
1111
	  gfc_error ("Procedure '%s' in %s at %L is neither function nor "
1109
	    gfc_error ("Procedure '%s' in %s at %L has no explicit interface",
1112
		     "subroutine", p->sym->name, interface_name,
1110
		       p->sym->name, interface_name, &p->sym->declared_at);
1113
		     &p->sym->declared_at);
1111
	  else
1112
	    gfc_error ("Procedure '%s' in %s at %L is neither function nor "
1113
		       "subroutine", p->sym->name, interface_name,
1114
		       &p->sym->declared_at);
1115
	  return 1;
1116
	}
1117
1118
      if (p->sym->attr.proc == PROC_INTERNAL
1119
	  && gfc_notify_std (GFC_STD_GNU, "Extension: Internal procedure '%s' "
1120
			     "in %s at %L", p->sym->name, interface_name,
1121
			     &p->sym->declared_at) == FAILURE)
1114
	return 1;
1122
	return 1;
1115
      }
1123
    }
1124
1116
  p = psave;
1125
  p = psave;
1117
1126
1118
  /* Remove duplicate interfaces in this interface list.  */
1127
  /* Remove duplicate interfaces in this interface list.  */

Return to bug 48279