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

Collapse All | Expand All

(-)a/gcc/fortran/gfortran.h (-1 / +1 lines)
Lines 683-689 typedef struct Link Here
683
683
684
  unsigned in_namelist:1, in_common:1, in_equivalence:1;
684
  unsigned in_namelist:1, in_common:1, in_equivalence:1;
685
  unsigned function:1, subroutine:1, procedure:1;
685
  unsigned function:1, subroutine:1, procedure:1;
686
  unsigned generic:1, generic_copy:1;
686
  unsigned generic:1, generic_copy:1, dt_generic:1;
687
  unsigned implicit_type:1;	/* Type defined via implicit rules.  */
687
  unsigned implicit_type:1;	/* Type defined via implicit rules.  */
688
  unsigned untyped:1;		/* No implicit type could be found.  */
688
  unsigned untyped:1;		/* No implicit type could be found.  */
689
689
(-)a/gcc/fortran/interface.c (-1 / +30 lines)
Lines 212-217 gfc_match_interface (void) Link Here
212
      if (gfc_get_symbol (name, NULL, &sym))
212
      if (gfc_get_symbol (name, NULL, &sym))
213
	return MATCH_ERROR;
213
	return MATCH_ERROR;
214
214
215
      /* Special case: Generic procedure with same name as a derived type.  */
216
      if (sym->attr.flavor == FL_DERIVED)
217
	{
218
	  size_t len;
219
	  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: GENERIC name the "
220
			      "same as a derived-type name at %C") == FAILURE)
221
	    return MATCH_ERROR;
222
223
          sym->attr.dt_generic = 1;
224
225
	  len = strlen (name);
226
	  gcc_assert(len+2 <= sizeof (name));
227
	  name[len] = '@';
228
	  name[len+1] = '\0';
229
230
	  if (gfc_get_symbol (name, NULL, &sym))
231
	    return MATCH_ERROR;
232
233
          sym->attr.dt_generic = 1;
234
	}
235
215
      if (!sym->attr.generic 
236
      if (!sym->attr.generic 
216
	  && gfc_add_generic (&sym->attr, sym->name, NULL) == FAILURE)
237
	  && gfc_add_generic (&sym->attr, sym->name, NULL) == FAILURE)
217
	return MATCH_ERROR;
238
	return MATCH_ERROR;
Lines 338-345 gfc_match_end_interface (void) Link Here
338
      break;
359
      break;
339
360
340
    case INTERFACE_GENERIC:
361
    case INTERFACE_GENERIC:
362
      if (current_interface.sym->attr.dt_generic)
363
	{
364
	  size_t len = strlen (name);
365
	  gcc_assert (len+2 <= sizeof (name));
366
	  name[len] = '@';
367
	  name[len+1] = '\0';
368
	}
369
341
      if (type != current_interface.type
370
      if (type != current_interface.type
342
	  || strcmp (current_interface.sym->name, name) != 0)
371
	  && strcmp (current_interface.sym->name, name) != 0)
343
	{
372
	{
344
	  gfc_error ("Expecting 'END INTERFACE %s' at %C",
373
	  gfc_error ("Expecting 'END INTERFACE %s' at %C",
345
		     current_interface.sym->name);
374
		     current_interface.sym->name);
(-)a/gcc/fortran/module.c (-1 / +7 lines)
Lines 1674-1680 typedef enum Link Here
1674
  AB_POINTER_COMP, AB_PRIVATE_COMP, AB_VALUE, AB_VOLATILE, AB_PROTECTED,
1674
  AB_POINTER_COMP, AB_PRIVATE_COMP, AB_VALUE, AB_VOLATILE, AB_PROTECTED,
1675
  AB_IS_BIND_C, AB_IS_C_INTEROP, AB_IS_ISO_C, AB_ABSTRACT, AB_ZERO_COMP,
1675
  AB_IS_BIND_C, AB_IS_C_INTEROP, AB_IS_ISO_C, AB_ABSTRACT, AB_ZERO_COMP,
1676
  AB_IS_CLASS, AB_PROCEDURE, AB_PROC_POINTER, AB_ASYNCHRONOUS, AB_CODIMENSION,
1676
  AB_IS_CLASS, AB_PROCEDURE, AB_PROC_POINTER, AB_ASYNCHRONOUS, AB_CODIMENSION,
1677
  AB_COARRAY_COMP, AB_VTYPE, AB_VTAB
1677
  AB_COARRAY_COMP, AB_VTYPE, AB_VTAB, AB_DT_GENERIC
1678
}
1678
}
1679
ab_attribute;
1679
ab_attribute;
1680
1680
Lines 1722-1727 static const mstring attr_bits[] = Link Here
1722
    minit ("PROC_POINTER", AB_PROC_POINTER),
1722
    minit ("PROC_POINTER", AB_PROC_POINTER),
1723
    minit ("VTYPE", AB_VTYPE),
1723
    minit ("VTYPE", AB_VTYPE),
1724
    minit ("VTAB", AB_VTAB),
1724
    minit ("VTAB", AB_VTAB),
1725
    minit ("DT_GENERIC", AB_DT_GENERIC),
1725
    minit (NULL, -1)
1726
    minit (NULL, -1)
1726
};
1727
};
1727
1728
Lines 1886-1891 mio_symbol_attribute (symbol_attribute *attr) Link Here
1886
	MIO_NAME (ab_attribute) (AB_VTYPE, attr_bits);
1887
	MIO_NAME (ab_attribute) (AB_VTYPE, attr_bits);
1887
      if (attr->vtab)
1888
      if (attr->vtab)
1888
	MIO_NAME (ab_attribute) (AB_VTAB, attr_bits);
1889
	MIO_NAME (ab_attribute) (AB_VTAB, attr_bits);
1890
      if (attr->dt_generic)
1891
	MIO_NAME (ab_attribute) (AB_DT_GENERIC, attr_bits);
1889
1892
1890
      mio_rparen ();
1893
      mio_rparen ();
1891
1894
Lines 2028-2033 mio_symbol_attribute (symbol_attribute *attr) Link Here
2028
	    case AB_VTAB:
2031
	    case AB_VTAB:
2029
	      attr->vtab = 1;
2032
	      attr->vtab = 1;
2030
	      break;
2033
	      break;
2034
	    case AB_DT_GENERIC:
2035
	      attr->dt_generic = 1;
2036
	      break;
2031
	    }
2037
	    }
2032
	}
2038
	}
2033
    }
2039
    }
(-)a/gcc/fortran/primary.c (+8 lines)
Lines 2629-2634 gfc_match_rvalue (gfc_expr **result) Link Here
2629
      sym = gfc_use_derived (sym);
2629
      sym = gfc_use_derived (sym);
2630
      if (sym == NULL)
2630
      if (sym == NULL)
2631
	m = MATCH_ERROR;
2631
	m = MATCH_ERROR;
2632
      else if (sym->attr.dt_generic)
2633
	{
2634
	  size_t len = strlen (name);
2635
	  gcc_assert (len+2 <= sizeof (name));
2636
	  name[len] = '@';
2637
	  name[len+1] = '\0';
2638
	  goto generic_function;
2639
	}
2632
      else
2640
      else
2633
	m = gfc_match_structure_constructor (sym, &e, false);
2641
	m = gfc_match_structure_constructor (sym, &e, false);
2634
      break;
2642
      break;
(-)a/gcc/fortran/resolve.c (-2 / +12 lines)
Lines 1991-1998 generic: Link Here
1991
     that possesses a matching interface.  14.1.2.4  */
1991
     that possesses a matching interface.  14.1.2.4  */
1992
  if (sym && !gfc_is_intrinsic (sym, 0, expr->where))
1992
  if (sym && !gfc_is_intrinsic (sym, 0, expr->where))
1993
    {
1993
    {
1994
      gfc_error ("There is no specific function for the generic '%s' at %L",
1994
      if (!sym->attr.dt_generic)
1995
		 expr->symtree->n.sym->name, &expr->where);
1995
	{
1996
	  gfc_error ("There is no specific function for the generic '%s' "
1997
		     "at %L", expr->symtree->n.sym->name, &expr->where);
1998
	  return FAILURE;
1999
	}
2000
2001
      /* FIXME: Convert expr->value.function.actual into gfc_constructor
2002
	 to be useable for resolve_structure_cons; see also:
2003
	 gfc_match_structure_constructor.  */
2004
      gfc_error ("Sorry, calling structure constructor '%s' not yet possible "
2005
		 "at %L", expr->symtree->n.sym->name, &expr->where);
1996
      return FAILURE;
2006
      return FAILURE;
1997
    }
2007
    }
1998
2008
(-)a/gcc/fortran/symbol.c (+2 lines)
Lines 1756-1761 gfc_copy_attr (symbol_attribute *dest, symbol_attribute *src, locus *where) Link Here
1756
    goto fail;
1756
    goto fail;
1757
  if (src->subroutine && gfc_add_subroutine (dest, NULL, where) == FAILURE)
1757
  if (src->subroutine && gfc_add_subroutine (dest, NULL, where) == FAILURE)
1758
    goto fail;
1758
    goto fail;
1759
  if (src->dt_generic)
1760
    dest->dt_generic = 1;
1759
1761
1760
  if (src->sequence && gfc_add_sequence (dest, NULL, where) == FAILURE)
1762
  if (src->sequence && gfc_add_sequence (dest, NULL, where) == FAILURE)
1761
    goto fail;
1763
    goto fail;

Return to bug 39427