aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/intrinsic.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran/intrinsic.c')
-rw-r--r--gcc/fortran/intrinsic.c39
1 files changed, 39 insertions, 0 deletions
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 05452c2..67d95df 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -79,6 +79,10 @@ gfc_type_letter (bt type)
c = 'c';
break;
+ case BT_HOLLERITH:
+ c = 'h';
+ break;
+
default:
c = 'u';
break;
@@ -2327,6 +2331,31 @@ add_conversions (void)
BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
}
+ if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
+ {
+ /* Hollerith-Integer conversions. */
+ for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
+ add_conv (BT_HOLLERITH, gfc_default_character_kind,
+ BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
+ /* Hollerith-Real conversions. */
+ for (i = 0; gfc_real_kinds[i].kind != 0; i++)
+ add_conv (BT_HOLLERITH, gfc_default_character_kind,
+ BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
+ /* Hollerith-Complex conversions. */
+ for (i = 0; gfc_real_kinds[i].kind != 0; i++)
+ add_conv (BT_HOLLERITH, gfc_default_character_kind,
+ BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
+
+ /* Hollerith-Character conversions. */
+ add_conv (BT_HOLLERITH, gfc_default_character_kind, BT_CHARACTER,
+ gfc_default_character_kind, GFC_STD_LEGACY);
+
+ /* Hollerith-Logical conversions. */
+ for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
+ add_conv (BT_HOLLERITH, gfc_default_character_kind,
+ BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
+ }
+
/* Real/Complex - Real/Complex conversions. */
for (i = 0; gfc_real_kinds[i].kind != 0; i++)
for (j = 0; gfc_real_kinds[j].kind != 0; j++)
@@ -2713,6 +2742,16 @@ do_simplify (gfc_intrinsic_sym * specific, gfc_expr * e)
gfc_expr *result, *a1, *a2, *a3, *a4, *a5;
gfc_actual_arglist *arg;
+ /* Check the arguments if there are Hollerith constants. We deal with
+ them at run-time. */
+ for (arg = e->value.function.actual; arg != NULL; arg = arg->next)
+ {
+ if (arg->expr && arg->expr->from_H)
+ {
+ result = NULL;
+ goto finish;
+ }
+ }
/* Max and min require special handling due to the variable number
of args. */
if (specific->simplify.f1 == gfc_simplify_min)