static tree gfc_build_logical_type (gfc_logical_info *info) { int bit_size = info->bit_size; tree new_type; if (bit_size == BOOL_TYPE_SIZE) { info->c_bool = 1; return boolean_type_node; } new_type = make_unsigned_type (bit_size); TREE_SET_CODE (new_type, BOOLEAN_TYPE); TYPE_MAX_VALUE (new_type) = build_int_cst (new_type, 1); TYPE_PRECISION (new_type) = 1; return new_type; }
/* Return TRUE if no error and lhstype and rhstype are not error_type */ bool check_assignment(type lhstype, type rhstype, expression rhs, const char *context, data_declaration fundecl, const char *funname, int parmnum) { bool zerorhs = rhs && definite_zero(rhs); if (lhstype == error_type || rhstype == error_type) return FALSE; if (type_void(rhstype)) { error("void value not ignored as it ought to be"); return FALSE; } if (type_equal_unqualified(lhstype, rhstype)) return TRUE; if (type_arithmetic(lhstype) && type_arithmetic(rhstype)) { if (rhs) constant_overflow_warning(rhs->cst); return check_conversion(lhstype, rhstype); } if (parmnum && (type_qualifiers(lhstype) & transparent_qualifier)) { /* See if we can match any field of lhstype */ tag_declaration tag = type_tag(lhstype); field_declaration fields, marginal_field = NULL; /* I blame gcc for this horrible mess (and it's minor inconsistencies with the regular rules) */ /* pedantic warnings are skipped in here because we're already issuing a warning for the use of this construct */ for (fields = tag->fieldlist; fields; fields = fields->next) { type ft = fields->type; if (type_compatible(ft, rhstype)) break; if (!type_pointer(ft)) continue; if (type_pointer(rhstype)) { type ttl = type_points_to(ft), ttr = type_points_to(rhstype); bool goodmatch = assignable_pointer_targets(ttl, ttr, FALSE); /* Any non-function converts to a [const][volatile] void * and vice versa; otherwise, targets must be the same. Meanwhile, the lhs target must have all the qualifiers of the rhs. */ if (goodmatch) { /* If this type won't generate any warnings, use it. */ if ((type_function(ttr) && type_function(ttl)) ? (((!type_const(ttl)) | type_const(ttr)) & ((!type_volatile(ttl)) | type_volatile(ttr))) : (((type_const(ttl)) | (!type_const(ttr))) & (type_volatile(ttl) | (!type_volatile(ttr))))) break; /* Keep looking for a better type, but remember this one. */ if (!marginal_field) marginal_field = fields; } } /* Can convert integer zero to any pointer type. */ /* Note that this allows passing *any* null pointer (gcc bug?) */ if (zerorhs) break; } if (fields || marginal_field) { if (!fields) { /* We have only a marginally acceptable member type; it needs a warning. */ type ttl = type_points_to(marginal_field->type), ttr = type_points_to(rhstype); ptrconversion_warnings(ttl, ttr, rhs, context, funname, parmnum, FALSE); } if (pedantic && !(fundecl && fundecl->in_system_header)) pedwarn("ANSI C prohibits argument conversion to union type"); return TRUE; } } if (type_pointer(lhstype) && type_pointer(rhstype)) { type ttl = type_points_to(lhstype), ttr = type_points_to(rhstype); bool goodmatch = assignable_pointer_targets(ttl, ttr, pedantic); /* Any non-function converts to a [const][volatile] void * and vice versa; otherwise, targets must be the same. Meanwhile, the lhs target must have all the qualifiers of the rhs. */ if (goodmatch || (type_equal_unqualified(make_unsigned_type(ttl), make_unsigned_type(ttr)))) ptrconversion_warnings(ttl, ttr, rhs, context, funname, parmnum, pedantic); else warn_for_assignment("%s from incompatible pointer type", context, funname, parmnum); return check_conversion(lhstype, rhstype); } /* enum = ptr and ptr = enum counts as an error, so use type_integral */ else if (type_pointer(lhstype) && type_integral(rhstype)) { if (!zerorhs) warn_for_assignment("%s makes pointer from integer without a cast", context, funname, parmnum); return check_conversion(lhstype, rhstype); } else if (type_integral(lhstype) && type_pointer(rhstype)) { warn_for_assignment("%s makes integer from pointer without a cast", context, funname, parmnum); return check_conversion(lhstype, rhstype); } if (!context) if (funname) error("incompatible type for argument %d of `%s'", parmnum, funname); else error("incompatible type for argument %d of indirect function call", parmnum); else error("incompatible types in %s", context); return FALSE; }