tree gfc_conv_string_init (tree length, gfc_expr * expr) { gfc_char_t *s; HOST_WIDE_INT len; int slen; tree str; bool free_s = false; gcc_assert (expr->expr_type == EXPR_CONSTANT); gcc_assert (expr->ts.type == BT_CHARACTER); gcc_assert (INTEGER_CST_P (length)); gcc_assert (TREE_INT_CST_HIGH (length) == 0); len = TREE_INT_CST_LOW (length); slen = expr->value.character.length; if (len > slen) { s = gfc_get_wide_string (len); memcpy (s, expr->value.character.string, slen * sizeof (gfc_char_t)); gfc_wide_memset (&s[slen], ' ', len - slen); free_s = true; } else s = expr->value.character.string; str = gfc_build_wide_string_const (expr->ts.kind, len, s); if (free_s) free (s); return str; }
static gfc_expr * create_character_initializer (gfc_expr *init, gfc_typespec *ts, gfc_ref *ref, gfc_expr *rvalue) { int len, start, end, tlen; gfc_char_t *dest; bool alloced_init = false; gfc_extract_int (ts->u.cl->length, &len); if (init == NULL) { /* Create a new initializer. */ init = gfc_get_character_expr (ts->kind, NULL, NULL, len); init->ts = *ts; alloced_init = true; } dest = init->value.character.string; if (ref) { gfc_expr *start_expr, *end_expr; gcc_assert (ref->type == REF_SUBSTRING); /* Only set a substring of the destination. Fortran substring bounds are one-based [start, end], we want zero based [start, end). */ start_expr = gfc_copy_expr (ref->u.ss.start); end_expr = gfc_copy_expr (ref->u.ss.end); if ((!gfc_simplify_expr(start_expr, 1)) || !(gfc_simplify_expr(end_expr, 1))) { gfc_error ("failure to simplify substring reference in DATA " "statement at %L", &ref->u.ss.start->where); gfc_free_expr (start_expr); gfc_free_expr (end_expr); if (alloced_init) gfc_free_expr (init); return NULL; } gfc_extract_int (start_expr, &start); gfc_free_expr (start_expr); start--; gfc_extract_int (end_expr, &end); gfc_free_expr (end_expr); } else { /* Set the whole string. */ start = 0; end = len; } /* Copy the initial value. */ if (rvalue->ts.type == BT_HOLLERITH) len = rvalue->representation.length - rvalue->ts.u.pad; else len = rvalue->value.character.length; tlen = end - start; if (len > tlen) { if (tlen < 0) { gfc_warning_now (0, "Unused initialization string at %L because " "variable has zero length", &rvalue->where); len = 0; } else { gfc_warning_now (0, "Initialization string at %L was truncated to " "fit the variable (%d/%d)", &rvalue->where, tlen, len); len = tlen; } } if (rvalue->ts.type == BT_HOLLERITH) { int i; for (i = 0; i < len; i++) dest[start+i] = rvalue->representation.string[i]; } else memcpy (&dest[start], rvalue->value.character.string, len * sizeof (gfc_char_t)); /* Pad with spaces. Substrings will already be blanked. */ if (len < tlen && ref == NULL) gfc_wide_memset (&dest[start + len], ' ', end - (start + len)); if (rvalue->ts.type == BT_HOLLERITH) { init->representation.length = init->value.character.length; init->representation.string = gfc_widechar_to_char (init->value.character.string, init->value.character.length); } return init; }
static gfc_expr * create_character_intializer (gfc_expr *init, gfc_typespec *ts, gfc_ref *ref, gfc_expr *rvalue) { int len, start, end; gfc_char_t *dest; gfc_extract_int (ts->cl->length, &len); if (init == NULL) { /* Create a new initializer. */ init = gfc_get_expr (); init->expr_type = EXPR_CONSTANT; init->ts = *ts; dest = gfc_get_wide_string (len + 1); dest[len] = '\0'; init->value.character.length = len; init->value.character.string = dest; /* Blank the string if we're only setting a substring. */ if (ref != NULL) gfc_wide_memset (dest, ' ', len); } else dest = init->value.character.string; if (ref) { gfc_expr *start_expr, *end_expr; gcc_assert (ref->type == REF_SUBSTRING); /* Only set a substring of the destination. Fortran substring bounds are one-based [start, end], we want zero based [start, end). */ start_expr = gfc_copy_expr (ref->u.ss.start); end_expr = gfc_copy_expr (ref->u.ss.end); if ((gfc_simplify_expr (start_expr, 1) == FAILURE) || (gfc_simplify_expr (end_expr, 1)) == FAILURE) { gfc_error ("failure to simplify substring reference in DATA " "statement at %L", &ref->u.ss.start->where); return NULL; } gfc_extract_int (start_expr, &start); start--; gfc_extract_int (end_expr, &end); } else { /* Set the whole string. */ start = 0; end = len; } /* Copy the initial value. */ if (rvalue->ts.type == BT_HOLLERITH) len = rvalue->representation.length; else len = rvalue->value.character.length; if (len > end - start) { len = end - start; gfc_warning_now ("initialization string truncated to match variable " "at %L", &rvalue->where); } if (rvalue->ts.type == BT_HOLLERITH) { int i; for (i = 0; i < len; i++) dest[start+i] = rvalue->representation.string[i]; } else memcpy (&dest[start], rvalue->value.character.string, len * sizeof (gfc_char_t)); /* Pad with spaces. Substrings will already be blanked. */ if (len < end - start && ref == NULL) gfc_wide_memset (&dest[start + len], ' ', end - (start + len)); if (rvalue->ts.type == BT_HOLLERITH) { init->representation.length = init->value.character.length; init->representation.string = gfc_widechar_to_char (init->value.character.string, init->value.character.length); } return init; }