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; } } }