diff options
Diffstat (limited to 'gcc/fortran/misc.c')
| -rw-r--r-- | gcc/fortran/misc.c | 71 |
1 files changed, 70 insertions, 1 deletions
diff --git a/gcc/fortran/misc.c b/gcc/fortran/misc.c index eed203d..97df9ee 100644 --- a/gcc/fortran/misc.c +++ b/gcc/fortran/misc.c @@ -129,6 +129,7 @@ gfc_typename (gfc_typespec *ts) static int flag = 0; char *buffer; gfc_typespec *ts1; + gfc_charlen_t length = 0; buffer = flag ? buffer1 : buffer2; flag = !flag; @@ -148,7 +149,13 @@ gfc_typename (gfc_typespec *ts) sprintf (buffer, "LOGICAL(%d)", ts->kind); break; case BT_CHARACTER: - sprintf (buffer, "CHARACTER(%d)", ts->kind); + if (ts->u.cl && ts->u.cl->length) + length = gfc_mpz_get_hwi (ts->u.cl->length->value.integer); + if (ts->kind == gfc_default_character_kind) + sprintf (buffer, "CHARACTER(" HOST_WIDE_INT_PRINT_DEC ")", length); + else + sprintf (buffer, "CHARACTER(" HOST_WIDE_INT_PRINT_DEC ",%d)", length, + ts->kind); break; case BT_HOLLERITH: sprintf (buffer, "HOLLERITH"); @@ -186,6 +193,68 @@ gfc_typename (gfc_typespec *ts) } +const char * +gfc_typename (gfc_expr *ex) +{ + /* 34 character buffer: 14 for "CHARACTER(n,4)", n can be upto 20 characters, + add 19 for the extra width and 1 for '\0' */ + static char buffer1[34]; + static char buffer2[34]; + static bool flag = false; + char *buffer; + gfc_charlen_t length; + buffer = flag ? buffer1 : buffer2; + flag = !flag; + + if (ex->ts.type == BT_CHARACTER) + { + if (ex->ts.u.cl && ex->ts.u.cl->length) + length = gfc_mpz_get_hwi (ex->ts.u.cl->length->value.integer); + else + length = ex->value.character.length; + if (ex->ts.kind == gfc_default_character_kind) + sprintf (buffer, "CHARACTER(" HOST_WIDE_INT_PRINT_DEC ")", length); + else + sprintf (buffer, "CHARACTER(" HOST_WIDE_INT_PRINT_DEC ",%d)", length, + ex->ts.kind); + return buffer; + } + return gfc_typename(&ex->ts); +} + +/* The type of a dummy variable can also be CHARACTER(*). */ + +const char * +gfc_dummy_typename (gfc_typespec *ts) +{ + static char buffer1[15]; /* 15 for "CHARACTER(*,4)" + '\0'. */ + static char buffer2[15]; + static bool flag = false; + char *buffer; + + buffer = flag ? buffer1 : buffer2; + flag = !flag; + + if (ts->type == BT_CHARACTER) + { + bool has_length = false; + if (ts->u.cl) + has_length = ts->u.cl->length != NULL; + if (!has_length) + { + if (ts->kind == gfc_default_character_kind) + sprintf(buffer, "CHARACTER(*)"); + else if (ts->kind < 10) + sprintf(buffer, "CHARACTER(*,%d)", ts->kind); + else + sprintf(buffer, "CHARACTER(*,?)"); + return buffer; + } + } + return gfc_typename(ts); +} + + /* Given an mstring array and a code, locate the code in the table, returning a pointer to the string. */ |