View | Details | Raw Unified | Return to bug 33162 | Differences between
and this patch

Collapse All | Expand All | Context: (Patch / File /
)

(-)decl.c (-11 / +5 lines)
 Lines 3968-3986   match_procedure_decl (void) Link Here 
3968
		    "in PROCEDURE statement at %C", proc_if->name);
3968
		    "in PROCEDURE statement at %C", proc_if->name);
3969
	  return MATCH_ERROR;
3969
	  return MATCH_ERROR;
3970
	}
3970
	}
3971
      /* TODO: Allow intrinsics with gfc_intrinsic_actual_ok
3972
	 (proc_if->name, 0) after PR33162 is fixed.  */
3973
      if (proc_if->attr.intrinsic)
3974
	{
3975
	  gfc_error ("Fortran 2003: Support for intrinsic procedure '%s' "
3976
		     "in PROCEDURE statement at %C not yet implemented "
3977
		     "in gfortran", proc_if->name);
3978
	  return MATCH_ERROR;
3979
	}
3980
    }
3971
    }
3981
3972
3982
got_ts:
3973
got_ts:
3983
3984
  if (gfc_match (" )") != MATCH_YES)
3974
  if (gfc_match (" )") != MATCH_YES)
3985
    {
3975
    {
3986
      gfc_current_locus = entry_loc;
3976
      gfc_current_locus = entry_loc;
 Lines 3995-4001   got_ts: Link Here 
3995
  /* Get procedure symbols.  */
3985
  /* Get procedure symbols.  */
3996
  for(num=1;;num++)
3986
  for(num=1;;num++)
3997
    {
3987
    {
3998
3999
      m = gfc_match_symbol (&sym, 0);
3988
      m = gfc_match_symbol (&sym, 0);
4000
      if (m == MATCH_NO)
3989
      if (m == MATCH_NO)
4001
	goto syntax;
3990
	goto syntax;
 Lines 4033-4044   got_ts: Link Here 
4033
	    return MATCH_ERROR;
4022
	    return MATCH_ERROR;
4034
	}
4023
	}
4035
4024
4025
      if (proc_if != NULL && proc_if->attr.intrinsic
4026
	  && gfc_intrinsic_actual_ok (proc_if->name, 0))
4027
	goto set_if;
4028
4036
      if (!sym->attr.pointer && gfc_add_external (&sym->attr, NULL) == FAILURE)
4029
      if (!sym->attr.pointer && gfc_add_external (&sym->attr, NULL) == FAILURE)
4037
	return MATCH_ERROR;
4030
	return MATCH_ERROR;
4038
      if (gfc_add_proc (&sym->attr, sym->name, NULL) == FAILURE)
4031
      if (gfc_add_proc (&sym->attr, sym->name, NULL) == FAILURE)
4039
	return MATCH_ERROR;
4032
	return MATCH_ERROR;
4040
4033
4041
      /* Set interface.  */
4034
      /* Set interface.  */
4035
set_if:
4042
      if (proc_if != NULL)
4036
      if (proc_if != NULL)
4043
	sym->interface = proc_if;
4037
	sym->interface = proc_if;
4044
      else if (current_ts.type != BT_UNKNOWN)
4038
      else if (current_ts.type != BT_UNKNOWN)
(-)resolve.c (+19 lines)
 Lines 1487-1492   resolve_specific_f0 (gfc_symbol *sym, gf Link Here 
1487
{
1487
{
1488
  match m;
1488
  match m;
1489
1489
1490
  if (sym->interface != NULL && sym->interface->attr.intrinsic)
1491
    {
1492
      sym->interface->refs = expr->symtree->n.sym->refs;
1493
      expr->symtree->n.sym = sym->interface;
1494
      return gfc_intrinsic_func_interface (expr, 1);
1495
    }
1496
1490
  if (sym->attr.external || sym->attr.if_source == IFSRC_IFBODY)
1497
  if (sym->attr.external || sym->attr.if_source == IFSRC_IFBODY)
1491
    {
1498
    {
1492
      if (sym->attr.dummy)
1499
      if (sym->attr.dummy)
 Lines 1580-1585   resolve_unknown_f (gfc_expr *expr) Link Here 
1580
      goto set_type;
1587
      goto set_type;
1581
    }
1588
    }
1582
1589
1590
  /* See if we have an intrinsic interface.  */
1591
1592
  if (sym->interface != NULL && sym->interface->attr.intrinsic)
1593
    {
1594
      sym->interface->refs++;
1595
      expr->symtree->n.sym = sym->interface;
1596
      if (gfc_intrinsic_func_interface (expr, 1) == MATCH_YES)
1597
	return SUCCESS;
1598
      return FAILURE;
1599
    }
1600
1601
1583
  /* See if we have an intrinsic function reference.  */
1602
  /* See if we have an intrinsic function reference.  */
1584
1603
1585
  if (gfc_intrinsic_name (sym->name, 0))
1604
  if (gfc_intrinsic_name (sym->name, 0))

Return to bug 33162