match
gfc_match_generic_spec (interface_type * type,
char *name,
gfc_intrinsic_op *operator)
{
char buffer[GFC_MAX_SYMBOL_LEN + 1];
match m;
gfc_intrinsic_op i;
if (gfc_match (" assignment ( = )") == MATCH_YES)
{
*type = INTERFACE_INTRINSIC_OP;
*operator = INTRINSIC_ASSIGN;
return MATCH_YES;
}
if (gfc_match (" operator ( %o )", &i) == MATCH_YES)
{ /* Operator i/f */
*type = INTERFACE_INTRINSIC_OP;
*operator = fold_unary (i);
return MATCH_YES;
}
if (gfc_match (" operator ( ") == MATCH_YES)
{
m = gfc_match_defined_op_name (buffer, 1);
if (m == MATCH_NO)
goto syntax;
if (m != MATCH_YES)
return MATCH_ERROR;
m = gfc_match_char (')');
if (m == MATCH_NO)
goto syntax;
if (m != MATCH_YES)
return MATCH_ERROR;
strcpy (name, buffer);
*type = INTERFACE_USER_OP;
return MATCH_YES;
}
if (gfc_match_name (buffer) == MATCH_YES)
{
strcpy (name, buffer);
*type = INTERFACE_GENERIC;
return MATCH_YES;
}
*type = INTERFACE_NAMELESS;
return MATCH_YES;
syntax:
gfc_error ("Syntax error in generic specification at %C");
return MATCH_ERROR;
}
expression make_unary(location loc, int unop, expression e)
{
switch (unop)
{
case kind_address_of:
return make_address_of(loc, e);
case kind_preincrement:
return make_preincrement(loc, e);
case kind_predecrement:
return make_predecrement(loc, e);
default:
{
expression result = CAST(expression, newkind_unary(parse_region, unop, loc, e));
type etype = default_conversion(e);
const char *errstring = NULL;
if (etype == error_type)
result->type = error_type;
else
{
switch (unop)
{
case kind_unary_plus:
if (!type_arithmetic(etype))
errstring = "wrong type argument to unary plus";
break;
case kind_unary_minus:
if (!type_arithmetic(etype))
errstring = "wrong type argument to unary minus";
break;
case kind_bitnot:
if (type_complex(etype))
result->kind = kind_conjugate;
else if (!type_integer(etype))
errstring = "wrong type argument to bit-complement";
break;
case kind_not:
if (!type_scalar(etype))
errstring = "wrong type argument to unary exclamation mark";
else
etype = int_type;
break;
case kind_realpart: case kind_imagpart:
if (!type_arithmetic(etype))
if (unop == kind_realpart)
errstring = "wrong type argument to __real__";
else
errstring = "wrong type argument to __imag__";
else
etype = type_complex(etype) ? make_base_type(etype) : etype;
default:
assert(0);
}
if (errstring)
{
error(errstring);
result->type = error_type;
}
else
{
result->type = etype;
result->cst = fold_unary(result);
}
}
return result;
}
}
}
