Mercurial > hg > CbC > CbC_gcc
diff gcc/fortran/trans-types.c @ 145:1830386684a0
gcc-9.2.0
author | anatofuz |
---|---|
date | Thu, 13 Feb 2020 11:34:05 +0900 |
parents | 84e7813d76e9 |
children |
line wrap: on
line diff
--- a/gcc/fortran/trans-types.c Thu Oct 25 07:37:49 2018 +0900 +++ b/gcc/fortran/trans-types.c Thu Feb 13 11:34:05 2020 +0900 @@ -1,5 +1,5 @@ /* Backend support for Fortran 95 basic types and derived types. - Copyright (C) 2002-2018 Free Software Foundation, Inc. + Copyright (C) 2002-2020 Free Software Foundation, Inc. Contributed by Paul Brook <paul@nowt.org> and Steven Bosscher <s.bosscher@student.tudelft.nl> @@ -1176,7 +1176,8 @@ { spec->type = BT_INTEGER; spec->kind = gfc_index_integer_kind; - spec->f90_type = BT_VOID; + spec->f90_type = BT_VOID; + spec->is_c_interop = 1; /* Mark as escaping later. */ } break; case BT_VOID: @@ -1193,6 +1194,9 @@ basetype = pfunc_type_node; } break; + case BT_PROCEDURE: + basetype = pfunc_type_node; + break; default: gcc_unreachable (); } @@ -1813,11 +1817,11 @@ TYPE_NAMELESS (fat_type) = 1; /* Add the data member as the first element of the descriptor. */ - decl = gfc_add_field_to_struct_1 (fat_type, - get_identifier ("data"), - (restricted - ? prvoid_type_node - : ptr_type_node), &chain); + gfc_add_field_to_struct_1 (fat_type, + get_identifier ("data"), + (restricted + ? prvoid_type_node + : ptr_type_node), &chain); /* Add the base component. */ decl = gfc_add_field_to_struct_1 (fat_type, @@ -2957,7 +2961,8 @@ || f->sym->ts.u.derived->attr.pointer_comp)) || (f->sym->ts.type == BT_CLASS && (CLASS_DATA (f->sym)->ts.u.derived->attr.proc_pointer_comp - || CLASS_DATA (f->sym)->ts.u.derived->attr.pointer_comp))) + || CLASS_DATA (f->sym)->ts.u.derived->attr.pointer_comp)) + || (f->sym->ts.type == BT_INTEGER && f->sym->ts.is_c_interop)) spec[spec_len++] = '.'; else if (f->sym->attr.intent == INTENT_IN) spec[spec_len++] = 'r'; @@ -2970,9 +2975,8 @@ return build_type_attribute_variant (fntype, tmp); } - tree -gfc_get_function_type (gfc_symbol * sym) +gfc_get_function_type (gfc_symbol * sym, gfc_actual_arglist *actual_args) { tree type; vec<tree, va_gc> *typelist = NULL; @@ -3030,6 +3034,10 @@ vec_safe_push (typelist, build_pointer_type(gfc_charlen_type_node)); } } + if (sym->backend_decl == error_mark_node && actual_args != NULL + && sym->formal == NULL && (sym->attr.proc == PROC_EXTERNAL + || sym->attr.proc == PROC_UNKNOWN)) + gfc_get_formal_from_actual_arglist (sym, actual_args); /* Build the argument types for the function. */ for (f = gfc_sym_get_dummy_args (sym); f; f = f->next) @@ -3090,6 +3098,16 @@ vec_safe_push (typelist, type); } + /* For noncharacter scalar intrinsic types, VALUE passes the value, + hence, the optional status cannot be transferred via a NULL pointer. + Thus, we will use a hidden argument in that case. */ + else if (arg + && arg->attr.optional + && arg->attr.value + && !arg->attr.dimension + && arg->ts.type != BT_CLASS + && !gfc_bt_struct (arg->ts.type)) + vec_safe_push (typelist, boolean_type_node); } if (!vec_safe_is_empty (typelist) @@ -3258,7 +3276,7 @@ int rank, dim; bool indirect = false; tree etype, ptype, t, base_decl; - tree data_off, dim_off, dtype_off, dim_size, elem_size; + tree data_off, span_off, dim_off, dtype_off, dim_size, elem_size; tree lower_suboff, upper_suboff, stride_suboff; tree dtype, field, rank_off; @@ -3315,12 +3333,13 @@ if (indirect) base_decl = build1 (INDIRECT_REF, ptype, base_decl); - elem_size = fold_convert (gfc_array_index_type, TYPE_SIZE_UNIT (etype)); - - gfc_get_descriptor_offsets_for_info (type, &data_off, &dtype_off, &dim_off, - &dim_size, &stride_suboff, + gfc_get_descriptor_offsets_for_info (type, &data_off, &dtype_off, &span_off, + &dim_off, &dim_size, &stride_suboff, &lower_suboff, &upper_suboff); + t = fold_build_pointer_plus (base_decl, span_off); + elem_size = build1 (INDIRECT_REF, gfc_array_index_type, t); + t = base_decl; if (!integer_zerop (data_off)) t = fold_build_pointer_plus (t, data_off);