Mercurial > hg > CbC > CbC_gcc
diff gcc/fortran/class.c @ 131:84e7813d76e9
gcc-8.2
author | mir3636 |
---|---|
date | Thu, 25 Oct 2018 07:37:49 +0900 |
parents | 04ced10e8804 |
children | 1830386684a0 |
line wrap: on
line diff
--- a/gcc/fortran/class.c Fri Oct 27 22:46:09 2017 +0900 +++ b/gcc/fortran/class.c Thu Oct 25 07:37:49 2018 +0900 @@ -1,5 +1,5 @@ /* Implementation of Fortran 2003 Polymorphism. - Copyright (C) 2009-2017 Free Software Foundation, Inc. + Copyright (C) 2009-2018 Free Software Foundation, Inc. Contributed by Paul Richard Thomas <pault@gcc.gnu.org> and Janus Weil <janus@gcc.gnu.org> @@ -35,7 +35,7 @@ * _vptr: A pointer to the vtable entry (see below) of the dynamic type. Only for unlimited polymorphic classes: - * _len: An integer(4) to store the string length when the unlimited + * _len: An integer(C_SIZE_T) to store the string length when the unlimited polymorphic pointer is used to point to a char array. The '_len' component will be zero when no character array is stored in '_data'. @@ -308,7 +308,6 @@ *full_array = true; } else if (ref->next && ref->next->type == REF_ARRAY - && !ref->next->next && ref->type == REF_COMPONENT && ref->next->u.ar.type != AR_ELEMENT) { @@ -602,7 +601,8 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr, gfc_array_spec **as) { - char name[GFC_MAX_SYMBOL_LEN+1], tname[GFC_MAX_SYMBOL_LEN+1]; + char tname[GFC_MAX_SYMBOL_LEN+1]; + char *name; gfc_symbol *fclass; gfc_symbol *vtab; gfc_component *c; @@ -633,17 +633,17 @@ rank = !(*as) || (*as)->rank == -1 ? GFC_MAX_DIMENSIONS : (*as)->rank; get_unique_hashed_string (tname, ts->u.derived); if ((*as) && attr->allocatable) - sprintf (name, "__class_%s_%d_%da", tname, rank, (*as)->corank); + name = xasprintf ("__class_%s_%d_%da", tname, rank, (*as)->corank); else if ((*as) && attr->pointer) - sprintf (name, "__class_%s_%d_%dp", tname, rank, (*as)->corank); + name = xasprintf ("__class_%s_%d_%dp", tname, rank, (*as)->corank); else if ((*as)) - sprintf (name, "__class_%s_%d_%dt", tname, rank, (*as)->corank); + name = xasprintf ("__class_%s_%d_%dt", tname, rank, (*as)->corank); else if (attr->pointer) - sprintf (name, "__class_%s_p", tname); + name = xasprintf ("__class_%s_p", tname); else if (attr->allocatable) - sprintf (name, "__class_%s_a", tname); + name = xasprintf ("__class_%s_a", tname); else - sprintf (name, "__class_%s_t", tname); + name = xasprintf ("__class_%s_t", tname); if (ts->u.derived->attr.unlimited_polymorphic) { @@ -738,6 +738,7 @@ ts->u.derived = fclass; attr->allocatable = attr->pointer = attr->dimension = attr->codimension = 0; (*as) = NULL; + free (name); return true; } @@ -1527,7 +1528,7 @@ gfc_component *comp; gfc_namespace *sub_ns; gfc_code *last_code, *block; - char name[GFC_MAX_SYMBOL_LEN+1]; + char *name; bool finalizable_comp = false; bool expr_null_wrapper = false; gfc_expr *ancestor_wrapper = NULL, *rank; @@ -1606,7 +1607,7 @@ sub_ns->resolved = 1; /* Set up the procedure symbol. */ - sprintf (name, "__final_%s", tname); + name = xasprintf ("__final_%s", tname); gfc_get_symbol (name, sub_ns, &final); sub_ns->proc_name = final; final->attr.flavor = FL_PROCEDURE; @@ -2172,6 +2173,7 @@ gfc_free_expr (rank); vtab_final->initializer = gfc_lval_expr_from_sym (final); vtab_final->ts.interface = final; + free (name); } @@ -2239,10 +2241,11 @@ if (ns) { - char name[GFC_MAX_SYMBOL_LEN+1], tname[GFC_MAX_SYMBOL_LEN+1]; + char tname[GFC_MAX_SYMBOL_LEN+1]; + char *name; get_unique_hashed_string (tname, derived); - sprintf (name, "__vtab_%s", tname); + name = xasprintf ("__vtab_%s", tname); /* Look for the vtab symbol in various namespaces. */ if (gsym && gsym->ns) @@ -2270,7 +2273,7 @@ vtab->attr.vtab = 1; vtab->attr.access = ACCESS_PUBLIC; gfc_set_sym_referenced (vtab); - sprintf (name, "__vtype_%s", tname); + name = xasprintf ("__vtype_%s", tname); gfc_find_symbol (name, ns, 0, &vtype); if (vtype == NULL) @@ -2313,13 +2316,13 @@ if (!gfc_add_component (vtype, "_size", &c)) goto cleanup; c->ts.type = BT_INTEGER; - c->ts.kind = 4; + c->ts.kind = gfc_size_kind; c->attr.access = ACCESS_PRIVATE; /* Remember the derived type in ts.u.derived, so that the correct initializer can be set later on (in gfc_conv_structure). */ c->ts.u.derived = derived; - c->initializer = gfc_get_int_expr (gfc_default_integer_kind, + c->initializer = gfc_get_int_expr (gfc_size_kind, NULL, 0); /* Add component _extends. */ @@ -2373,7 +2376,7 @@ else { /* Construct default initialization variable. */ - sprintf (name, "__def_init_%s", tname); + name = xasprintf ("__def_init_%s", tname); gfc_get_symbol (name, ns, &def_init); def_init->attr.target = 1; def_init->attr.artificial = 1; @@ -2406,7 +2409,7 @@ ns->contained = sub_ns; sub_ns->resolved = 1; /* Set up procedure symbol. */ - sprintf (name, "__copy_%s", tname); + name = xasprintf ("__copy_%s", tname); gfc_get_symbol (name, sub_ns, ©); sub_ns->proc_name = copy; copy->attr.flavor = FL_PROCEDURE; @@ -2483,7 +2486,7 @@ ns->contained = sub_ns; sub_ns->resolved = 1; /* Set up procedure symbol. */ - sprintf (name, "__deallocate_%s", tname); + name = xasprintf ("__deallocate_%s", tname); gfc_get_symbol (name, sub_ns, &dealloc); sub_ns->proc_name = dealloc; dealloc->attr.flavor = FL_PROCEDURE; @@ -2532,6 +2535,7 @@ vtab->ts.u.derived = vtype; vtab->value = gfc_default_initializer (&vtab->ts); } + free (name); } found_sym = vtab; @@ -2623,13 +2627,14 @@ if (ns) { - char name[GFC_MAX_SYMBOL_LEN+1], tname[GFC_MAX_SYMBOL_LEN+1]; + char tname[GFC_MAX_SYMBOL_LEN+1]; + char *name; /* Encode all types as TYPENAME_KIND_ including especially character arrays, whose length is now consistently stored in the _len component of the class-variable. */ sprintf (tname, "%s_%d_", gfc_basic_typename (ts->type), ts->kind); - sprintf (name, "__vtab_%s", tname); + name = xasprintf ("__vtab_%s", tname); /* Look for the vtab symbol in the top-level namespace only. */ gfc_find_symbol (name, ns, 0, &vtab); @@ -2646,7 +2651,7 @@ vtab->attr.vtab = 1; vtab->attr.access = ACCESS_PUBLIC; gfc_set_sym_referenced (vtab); - sprintf (name, "__vtype_%s", tname); + name = xasprintf ("__vtype_%s", tname); gfc_find_symbol (name, ns, 0, &vtype); if (vtype == NULL) @@ -2679,7 +2684,7 @@ if (!gfc_add_component (vtype, "_size", &c)) goto cleanup; c->ts.type = BT_INTEGER; - c->ts.kind = 4; + c->ts.kind = gfc_size_kind; c->attr.access = ACCESS_PRIVATE; /* Build a minimal expression to make use of @@ -2690,11 +2695,11 @@ e = gfc_get_expr (); e->ts = *ts; e->expr_type = EXPR_VARIABLE; - c->initializer = gfc_get_int_expr (gfc_default_integer_kind, + c->initializer = gfc_get_int_expr (gfc_size_kind, NULL, ts->type == BT_CHARACTER ? ts->kind - : (int)gfc_element_size (e)); + : gfc_element_size (e)); gfc_free_expr (e); /* Add component _extends. */ @@ -2722,12 +2727,12 @@ c->tb->ppc = 1; if (ts->type != BT_CHARACTER) - sprintf (name, "__copy_%s", tname); + name = xasprintf ("__copy_%s", tname); else { /* __copy is always the same for characters. Check to see if copy function already exists. */ - sprintf (name, "__copy_character_%d", ts->kind); + name = xasprintf ("__copy_character_%d", ts->kind); contained = ns->contained; for (; contained; contained = contained->sibling) if (contained->proc_name @@ -2796,6 +2801,7 @@ vtab->ts.u.derived = vtype; vtab->value = gfc_default_initializer (&vtab->ts); } + free (name); } found_sym = vtab;