View | Details | Raw Unified | Return to bug 43945
Collapse All | Expand All

(-)gcc/fortran/resolve.c (-32 / +52 lines)
Lines 5123-5128 Link Here
5123
}
5123
}
5124
5124
5125
5125
5126
/* Get the ultimate declared type from an expression.  In addition,
5127
   return the last class/derived type reference and the copy of the
5128
   reference list.  */
5129
static gfc_symbol*
5130
get_declared_from_expr (gfc_ref **class_ref, gfc_ref **new_ref,
5131
			gfc_expr *e)
5132
{
5133
  gfc_symbol *declared;
5134
  gfc_ref *ref;
5135
5136
  declared = NULL;
5137
  if (class_ref)
5138
    *class_ref = NULL;
5139
  if (new_ref)
5140
    *new_ref = gfc_copy_ref (e->ref);
5141
5142
  for (ref = e->ref; ref; ref = ref->next)
5143
    {
5144
      if (ref->type != REF_COMPONENT)
5145
	continue;
5146
5147
      if (ref->u.c.component->ts.type == BT_CLASS
5148
	    || ref->u.c.component->ts.type == BT_DERIVED)
5149
	{
5150
	  declared = ref->u.c.component->ts.u.derived;
5151
	  if (class_ref)
5152
	    *class_ref = ref;
5153
	}
5154
    }
5155
5156
  if (declared == NULL)
5157
    declared = e->symtree->n.sym->ts.u.derived;
5158
5159
  return declared;
5160
}
5161
5162
5126
/* Given an EXPR_COMPCALL calling a GENERIC typebound procedure, figure out
5163
/* Given an EXPR_COMPCALL calling a GENERIC typebound procedure, figure out
5127
   which of the specific bindings (if any) matches the arglist and transform
5164
   which of the specific bindings (if any) matches the arglist and transform
5128
   the expression into a call of that binding.  */
5165
   the expression into a call of that binding.  */
Lines 5132-5137 Link Here
5132
{
5169
{
5133
  gfc_typebound_proc* genproc;
5170
  gfc_typebound_proc* genproc;
5134
  const char* genname;
5171
  const char* genname;
5172
  gfc_symtree *st;
5173
  gfc_symbol *derived;
5135
5174
5136
  gcc_assert (e->expr_type == EXPR_COMPCALL);
5175
  gcc_assert (e->expr_type == EXPR_COMPCALL);
5137
  genname = e->value.compcall.name;
5176
  genname = e->value.compcall.name;
Lines 5199-5204 Link Here
5199
  return FAILURE;
5238
  return FAILURE;
5200
5239
5201
success:
5240
success:
5241
  /* Make sure that we have the right specific instance for the name.  */
5242
  genname = e->value.compcall.tbp->u.specific->name;
5243
5244
  /* Is the symtree name a "unique name"?  */
5245
  if (*genname == '@')
5246
    genname = e->value.compcall.tbp->u.specific->n.sym->name;
5247
5248
  derived = get_declared_from_expr (NULL, NULL, e);
5249
5250
  st = gfc_find_typebound_proc (derived, NULL, genname, false, &e->where);
5251
  if (st)
5252
    e->value.compcall.tbp = st->n.tb;
5253
5202
  return SUCCESS;
5254
  return SUCCESS;
5203
}
5255
}
5204
5256
Lines 5306-5344 Link Here
5306
}
5358
}
5307
5359
5308
5360
5309
/* Get the ultimate declared type from an expression.  In addition,
5310
   return the last class/derived type reference and the copy of the
5311
   reference list.  */
5312
static gfc_symbol*
5313
get_declared_from_expr (gfc_ref **class_ref, gfc_ref **new_ref,
5314
			gfc_expr *e)
5315
{
5316
  gfc_symbol *declared;
5317
  gfc_ref *ref;
5318
5361
5319
  declared = NULL;
5320
  *class_ref = NULL;
5321
  *new_ref = gfc_copy_ref (e->ref);
5322
  for (ref = *new_ref; ref; ref = ref->next)
5323
    {
5324
      if (ref->type != REF_COMPONENT)
5325
	continue;
5326
5327
      if (ref->u.c.component->ts.type == BT_CLASS
5328
	    || ref->u.c.component->ts.type == BT_DERIVED)
5329
	{
5330
	  declared = ref->u.c.component->ts.u.derived;
5331
	  *class_ref = ref;
5332
	}
5333
    }
5334
5335
  if (declared == NULL)
5336
    declared = e->symtree->n.sym->ts.u.derived;
5337
5338
  return declared;
5339
}
5340
5341
5342
/* Resolve a typebound function, or 'method'. First separate all
5362
/* Resolve a typebound function, or 'method'. First separate all
5343
   the non-CLASS references by calling resolve_compcall directly.  */
5363
   the non-CLASS references by calling resolve_compcall directly.  */
5344
5364

Return to bug 43945