/* Compiler arithmetic
- Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
Free Software Foundation, Inc.
Contributed by Andy Vaught
GCC is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free
-Software Foundation; either version 2, or (at your option) any later
+Software Foundation; either version 3, or (at your option) any later
version.
GCC is distributed in the hope that it will be useful, but WITHOUT ANY
for more details.
You should have received a copy of the GNU General Public License
-along with GCC; see the file COPYING. If not, write to the Free
-Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
-02110-1301, USA. */
+along with GCC; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
/* Since target arithmetic must be done on the host, there has to
be some way of evaluating arithmetic expressions as the host
{
gfc_integer_info *int_info;
gfc_real_info *real_info;
- mpfr_t a, b, c;
- mpz_t r;
+ mpfr_t a, b;
int i;
mpfr_set_default_prec (128);
mpfr_init (a);
- mpz_init (r);
/* Convert the minimum and maximum values for each kind into their
GNU MP representation. */
for (int_info = gfc_integer_kinds; int_info->kind != 0; int_info++)
{
/* Huge */
- mpz_set_ui (r, int_info->radix);
- mpz_pow_ui (r, r, int_info->digits);
-
mpz_init (int_info->huge);
- mpz_sub_ui (int_info->huge, r, 1);
+ mpz_set_ui (int_info->huge, int_info->radix);
+ mpz_pow_ui (int_info->huge, int_info->huge, int_info->digits);
+ mpz_sub_ui (int_info->huge, int_info->huge, 1);
/* These are the numbers that are actually representable by the
target. For bases other than two, this needs to be changed. */
mpfr_set_z (a, int_info->huge, GFC_RND_MODE);
mpfr_log10 (a, a, GFC_RND_MODE);
mpfr_trunc (a, a);
- gfc_mpfr_to_mpz (r, a);
- int_info->range = mpz_get_si (r);
+ int_info->range = (int) mpfr_get_si (a, GFC_RND_MODE);
}
mpfr_clear (a);
mpfr_init (a);
mpfr_init (b);
- mpfr_init (c);
/* huge(x) = (1 - b**(-p)) * b**(emax-1) * b */
- /* a = 1 - b**(-p) */
- mpfr_set_ui (a, 1, GFC_RND_MODE);
- mpfr_set_ui (b, real_info->radix, GFC_RND_MODE);
- mpfr_pow_si (b, b, -real_info->digits, GFC_RND_MODE);
- mpfr_sub (a, a, b, GFC_RND_MODE);
-
- /* c = b**(emax-1) */
- mpfr_set_ui (b, real_info->radix, GFC_RND_MODE);
- mpfr_pow_ui (c, b, real_info->max_exponent - 1, GFC_RND_MODE);
+ /* 1 - b**(-p) */
+ mpfr_init (real_info->huge);
+ mpfr_set_ui (real_info->huge, 1, GFC_RND_MODE);
+ mpfr_set_ui (a, real_info->radix, GFC_RND_MODE);
+ mpfr_pow_si (a, a, -real_info->digits, GFC_RND_MODE);
+ mpfr_sub (real_info->huge, real_info->huge, a, GFC_RND_MODE);
- /* a = a * c = (1 - b**(-p)) * b**(emax-1) */
- mpfr_mul (a, a, c, GFC_RND_MODE);
+ /* b**(emax-1) */
+ mpfr_set_ui (a, real_info->radix, GFC_RND_MODE);
+ mpfr_pow_ui (a, a, real_info->max_exponent - 1, GFC_RND_MODE);
- /* a = (1 - b**(-p)) * b**(emax-1) * b */
- mpfr_mul_ui (a, a, real_info->radix, GFC_RND_MODE);
+ /* (1 - b**(-p)) * b**(emax-1) */
+ mpfr_mul (real_info->huge, real_info->huge, a, GFC_RND_MODE);
- mpfr_init (real_info->huge);
- mpfr_set (real_info->huge, a, GFC_RND_MODE);
+ /* (1 - b**(-p)) * b**(emax-1) * b */
+ mpfr_mul_ui (real_info->huge, real_info->huge, real_info->radix,
+ GFC_RND_MODE);
/* tiny(x) = b**(emin-1) */
- mpfr_set_ui (b, real_info->radix, GFC_RND_MODE);
- mpfr_pow_si (b, b, real_info->min_exponent - 1, GFC_RND_MODE);
-
mpfr_init (real_info->tiny);
- mpfr_set (real_info->tiny, b, GFC_RND_MODE);
+ mpfr_set_ui (real_info->tiny, real_info->radix, GFC_RND_MODE);
+ mpfr_pow_si (real_info->tiny, real_info->tiny,
+ real_info->min_exponent - 1, GFC_RND_MODE);
/* subnormal (x) = b**(emin - digit) */
- mpfr_set_ui (b, real_info->radix, GFC_RND_MODE);
- mpfr_pow_si (b, b, real_info->min_exponent - real_info->digits,
- GFC_RND_MODE);
-
mpfr_init (real_info->subnormal);
- mpfr_set (real_info->subnormal, b, GFC_RND_MODE);
+ mpfr_set_ui (real_info->subnormal, real_info->radix, GFC_RND_MODE);
+ mpfr_pow_si (real_info->subnormal, real_info->subnormal,
+ real_info->min_exponent - real_info->digits, GFC_RND_MODE);
/* epsilon(x) = b**(1-p) */
- mpfr_set_ui (b, real_info->radix, GFC_RND_MODE);
- mpfr_pow_si (b, b, 1 - real_info->digits, GFC_RND_MODE);
-
mpfr_init (real_info->epsilon);
- mpfr_set (real_info->epsilon, b, GFC_RND_MODE);
+ mpfr_set_ui (real_info->epsilon, real_info->radix, GFC_RND_MODE);
+ mpfr_pow_si (real_info->epsilon, real_info->epsilon,
+ 1 - real_info->digits, GFC_RND_MODE);
/* range(x) = int(min(log10(huge(x)), -log10(tiny)) */
mpfr_log10 (a, real_info->huge, GFC_RND_MODE);
mpfr_neg (b, b, GFC_RND_MODE);
/* a = min(a, b) */
- if (mpfr_cmp (a, b) > 0)
- mpfr_set (a, b, GFC_RND_MODE);
-
+ mpfr_min (a, a, b, GFC_RND_MODE);
mpfr_trunc (a, a);
- gfc_mpfr_to_mpz (r, a);
- real_info->range = mpz_get_si (r);
+ real_info->range = (int) mpfr_get_si (a, GFC_RND_MODE);
/* precision(x) = int((p - 1) * log10(b)) + k */
mpfr_set_ui (a, real_info->radix, GFC_RND_MODE);
mpfr_log10 (a, a, GFC_RND_MODE);
-
mpfr_mul_ui (a, a, real_info->digits - 1, GFC_RND_MODE);
mpfr_trunc (a, a);
- gfc_mpfr_to_mpz (r, a);
- real_info->precision = mpz_get_si (r);
+ real_info->precision = (int) mpfr_get_si (a, GFC_RND_MODE);
/* If the radix is an integral power of 10, add one to the precision. */
for (i = 10; i <= real_info->radix; i *= 10)
if (i == real_info->radix)
real_info->precision++;
- mpfr_clear (a);
- mpfr_clear (b);
- mpfr_clear (c);
+ mpfr_clears (a, b, NULL);
}
-
- mpz_clear (r);
}
}
for (rp = gfc_real_kinds; rp->kind; rp++)
- {
- mpfr_clear (rp->epsilon);
- mpfr_clear (rp->huge);
- mpfr_clear (rp->tiny);
- mpfr_clear (rp->subnormal);
- }
+ mpfr_clears (rp->epsilon, rp->huge, rp->tiny, rp->subnormal, NULL);
+}
+
+
+/* Given a wide character value and a character kind, determine whether
+ the character is representable for that kind. */
+bool
+gfc_check_character_range (gfc_char_t c, int kind)
+{
+ /* As wide characters are stored as 32-bit values, they're all
+ representable in UCS=4. */
+ if (kind == 4)
+ return true;
+
+ if (kind == 1)
+ return c <= 255 ? true : false;
+
+ gcc_unreachable ();
}
mpfr_init (q);
mpfr_abs (q, p, GFC_RND_MODE);
+ retval = ARITH_OK;
+
if (mpfr_inf_p (p))
{
- if (gfc_option.flag_range_check == 0)
- retval = ARITH_OK;
- else
+ if (gfc_option.flag_range_check != 0)
retval = ARITH_OVERFLOW;
}
else if (mpfr_nan_p (p))
{
- if (gfc_option.flag_range_check == 0)
- retval = ARITH_OK;
- else
+ if (gfc_option.flag_range_check != 0)
retval = ARITH_NAN;
}
else if (mpfr_sgn (q) == 0)
- retval = ARITH_OK;
+ {
+ mpfr_clear (q);
+ return retval;
+ }
else if (mpfr_cmp (q, gfc_real_kinds[i].huge) > 0)
{
if (gfc_option.flag_range_check == 0)
- retval = ARITH_OK;
+ mpfr_set_inf (p, mpfr_sgn (p));
else
retval = ARITH_OVERFLOW;
}
else if (mpfr_cmp (q, gfc_real_kinds[i].subnormal) < 0)
{
if (gfc_option.flag_range_check == 0)
- retval = ARITH_OK;
+ {
+ if (mpfr_sgn (p) < 0)
+ {
+ mpfr_set_ui (p, 0, GFC_RND_MODE);
+ mpfr_set_si (q, -1, GFC_RND_MODE);
+ mpfr_copysign (p, p, q, GFC_RND_MODE);
+ }
+ else
+ mpfr_set_ui (p, 0, GFC_RND_MODE);
+ }
else
retval = ARITH_UNDERFLOW;
}
mpfr_neg (p, q, GMP_RNDN);
else
mpfr_set (p, q, GMP_RNDN);
-
- retval = ARITH_OK;
}
- else
- retval = ARITH_OK;
mpfr_clear (q);
gfc_range_check (gfc_expr *e)
{
arith rc;
+ arith rc2;
switch (e->ts.type)
{
if (rc == ARITH_NAN)
mpfr_set_nan (e->value.complex.r);
- rc = gfc_check_real_range (e->value.complex.i, e->ts.kind);
+ rc2 = gfc_check_real_range (e->value.complex.i, e->ts.kind);
if (rc == ARITH_UNDERFLOW)
mpfr_set_ui (e->value.complex.i, 0, GFC_RND_MODE);
if (rc == ARITH_OVERFLOW)
mpfr_set_inf (e->value.complex.i, mpfr_sgn (e->value.complex.i));
if (rc == ARITH_NAN)
mpfr_set_nan (e->value.complex.i);
+
+ if (rc == ARITH_OK)
+ rc = rc2;
break;
default:
mpfr_mul (y, op1->value.complex.i, op2->value.complex.r, GFC_RND_MODE);
mpfr_add (result->value.complex.i, x, y, GFC_RND_MODE);
- mpfr_clear (x);
- mpfr_clear (y);
+ mpfr_clears (x, y, NULL);
break;
default:
mpfr_div (result->value.complex.i, result->value.complex.i, div,
GFC_RND_MODE);
- mpfr_clear (x);
- mpfr_clear (y);
- mpfr_clear (div);
+ mpfr_clears (x, y, div, NULL);
break;
default:
static void
complex_reciprocal (gfc_expr *op)
{
- mpfr_t mod, a, re, im;
+ mpfr_t mod, tmp;
gfc_set_model (op->value.complex.r);
mpfr_init (mod);
- mpfr_init (a);
- mpfr_init (re);
- mpfr_init (im);
+ mpfr_init (tmp);
mpfr_mul (mod, op->value.complex.r, op->value.complex.r, GFC_RND_MODE);
- mpfr_mul (a, op->value.complex.i, op->value.complex.i, GFC_RND_MODE);
- mpfr_add (mod, mod, a, GFC_RND_MODE);
-
- mpfr_div (re, op->value.complex.r, mod, GFC_RND_MODE);
+ mpfr_mul (tmp, op->value.complex.i, op->value.complex.i, GFC_RND_MODE);
+ mpfr_add (mod, mod, tmp, GFC_RND_MODE);
- mpfr_neg (im, op->value.complex.i, GFC_RND_MODE);
- mpfr_div (im, im, mod, GFC_RND_MODE);
+ mpfr_div (op->value.complex.r, op->value.complex.r, mod, GFC_RND_MODE);
- mpfr_set (op->value.complex.r, re, GFC_RND_MODE);
- mpfr_set (op->value.complex.i, im, GFC_RND_MODE);
+ mpfr_neg (op->value.complex.i, op->value.complex.i, GFC_RND_MODE);
+ mpfr_div (op->value.complex.i, op->value.complex.i, mod, GFC_RND_MODE);
- mpfr_clear (re);
- mpfr_clear (im);
- mpfr_clear (mod);
- mpfr_clear (a);
+ mpfr_clears (tmp, mod, NULL);
}
mpfr_set (x_r, base->value.complex.r, GFC_RND_MODE);
mpfr_set (x_i, base->value.complex.i, GFC_RND_MODE);
-/* Macro for complex multiplication. We have to take care that
- res_r/res_i and a_r/a_i can (and will) be the same variable. */
+ /* Macro for complex multiplication. We have to take care that
+ res_r/res_i and a_r/a_i can (and will) be the same variable. */
#define CMULT(res_r,res_i,a_r,a_i,b_r,b_i) \
mpfr_mul (re, a_r, b_r, GFC_RND_MODE), \
mpfr_mul (tmp, a_i, b_i, GFC_RND_MODE), \
#undef res_i
#undef CMULT
- mpfr_clear (x_r);
- mpfr_clear (x_i);
- mpfr_clear (tmp);
- mpfr_clear (re);
- mpfr_clear (im);
+ mpfr_clears (x_r, x_i, tmp, re, im, NULL);
}
len = op1->value.character.length + op2->value.character.length;
- result->value.character.string = gfc_getmem (len + 1);
+ result->value.character.string = gfc_get_wide_string (len + 1);
result->value.character.length = len;
memcpy (result->value.character.string, op1->value.character.string,
- op1->value.character.length);
+ op1->value.character.length * sizeof (gfc_char_t));
- memcpy (result->value.character.string + op1->value.character.length,
- op2->value.character.string, op2->value.character.length);
+ memcpy (&result->value.character.string[op1->value.character.length],
+ op2->value.character.string,
+ op2->value.character.length * sizeof (gfc_char_t));
result->value.character.string[len] = '\0';
return ARITH_OK;
}
+/* Comparison between real values; returns 0 if (op1 .op. op2) is true.
+ This function mimics mpr_cmp but takes NaN into account. */
+
+static int
+compare_real (gfc_expr *op1, gfc_expr *op2, gfc_intrinsic_op op)
+{
+ int rc;
+ switch (op)
+ {
+ case INTRINSIC_EQ:
+ rc = mpfr_equal_p (op1->value.real, op2->value.real) ? 0 : 1;
+ break;
+ case INTRINSIC_GT:
+ rc = mpfr_greater_p (op1->value.real, op2->value.real) ? 1 : -1;
+ break;
+ case INTRINSIC_GE:
+ rc = mpfr_greaterequal_p (op1->value.real, op2->value.real) ? 1 : -1;
+ break;
+ case INTRINSIC_LT:
+ rc = mpfr_less_p (op1->value.real, op2->value.real) ? -1 : 1;
+ break;
+ case INTRINSIC_LE:
+ rc = mpfr_lessequal_p (op1->value.real, op2->value.real) ? -1 : 1;
+ break;
+ default:
+ gfc_internal_error ("compare_real(): Bad operator");
+ }
+
+ return rc;
+}
/* Comparison operators. Assumes that the two expression nodes
- contain two constants of the same type. */
+ contain two constants of the same type. The op argument is
+ needed to handle NaN correctly. */
int
-gfc_compare_expr (gfc_expr *op1, gfc_expr *op2)
+gfc_compare_expr (gfc_expr *op1, gfc_expr *op2, gfc_intrinsic_op op)
{
int rc;
break;
case BT_REAL:
- rc = mpfr_cmp (op1->value.real, op2->value.real);
+ rc = compare_real (op1, op2, op);
break;
case BT_CHARACTER:
static int
compare_complex (gfc_expr *op1, gfc_expr *op2)
{
- return (mpfr_cmp (op1->value.complex.r, op2->value.complex.r) == 0
- && mpfr_cmp (op1->value.complex.i, op2->value.complex.i) == 0);
+ return (mpfr_equal_p (op1->value.complex.r, op2->value.complex.r)
+ && mpfr_equal_p (op1->value.complex.i, op2->value.complex.i));
}
int
gfc_compare_string (gfc_expr *a, gfc_expr *b)
{
- int len, alen, blen, i, ac, bc;
+ int len, alen, blen, i;
+ gfc_char_t ac, bc;
alen = a->value.character.length;
blen = b->value.character.length;
- len = (alen > blen) ? alen : blen;
+ len = MAX(alen, blen);
for (i = 0; i < len; i++)
{
- /* We cast to unsigned char because default char, if it is signed,
- would lead to ac < 0 for string[i] > 127. */
- ac = (unsigned char) ((i < alen) ? a->value.character.string[i] : ' ');
- bc = (unsigned char) ((i < blen) ? b->value.character.string[i] : ' ');
+ ac = ((i < alen) ? a->value.character.string[i] : ' ');
+ bc = ((i < blen) ? b->value.character.string[i] : ' ');
if (ac < bc)
return -1;
}
/* Strings are equal */
+ return 0;
+}
+
+
+int
+gfc_compare_with_Cstring (gfc_expr *a, const char *b, bool case_sensitive)
+{
+ int len, alen, blen, i;
+ gfc_char_t ac, bc;
+
+ alen = a->value.character.length;
+ blen = strlen (b);
+
+ len = MAX(alen, blen);
+
+ for (i = 0; i < len; i++)
+ {
+ ac = ((i < alen) ? a->value.character.string[i] : ' ');
+ bc = ((i < blen) ? b[i] : ' ');
+
+ if (!case_sensitive)
+ {
+ ac = TOLOWER (ac);
+ bc = TOLOWER (bc);
+ }
+
+ if (ac < bc)
+ return -1;
+ if (ac > bc)
+ return 1;
+ }
+ /* Strings are equal */
return 0;
}
&op1->where);
result->value.logical = (op1->ts.type == BT_COMPLEX)
? compare_complex (op1, op2)
- : (gfc_compare_expr (op1, op2) == 0);
+ : (gfc_compare_expr (op1, op2, INTRINSIC_EQ) == 0);
*resultp = result;
return ARITH_OK;
&op1->where);
result->value.logical = (op1->ts.type == BT_COMPLEX)
? !compare_complex (op1, op2)
- : (gfc_compare_expr (op1, op2) != 0);
+ : (gfc_compare_expr (op1, op2, INTRINSIC_EQ) != 0);
*resultp = result;
return ARITH_OK;
result = gfc_constant_result (BT_LOGICAL, gfc_default_logical_kind,
&op1->where);
- result->value.logical = (gfc_compare_expr (op1, op2) > 0);
+ result->value.logical = (gfc_compare_expr (op1, op2, INTRINSIC_GT) > 0);
*resultp = result;
return ARITH_OK;
result = gfc_constant_result (BT_LOGICAL, gfc_default_logical_kind,
&op1->where);
- result->value.logical = (gfc_compare_expr (op1, op2) >= 0);
+ result->value.logical = (gfc_compare_expr (op1, op2, INTRINSIC_GE) >= 0);
*resultp = result;
return ARITH_OK;
result = gfc_constant_result (BT_LOGICAL, gfc_default_logical_kind,
&op1->where);
- result->value.logical = (gfc_compare_expr (op1, op2) < 0);
+ result->value.logical = (gfc_compare_expr (op1, op2, INTRINSIC_LT) < 0);
*resultp = result;
return ARITH_OK;
result = gfc_constant_result (BT_LOGICAL, gfc_default_logical_kind,
&op1->where);
- result->value.logical = (gfc_compare_expr (op1, op2) <= 0);
+ result->value.logical = (gfc_compare_expr (op1, op2, INTRINSIC_LE) <= 0);
*resultp = result;
return ARITH_OK;
for (c = head; c; c = c->next)
{
- rc = eval (c->expr, &r);
+ rc = reduce_unary (eval, c->expr, &r);
+
if (rc != ARITH_OK)
break;
for (c = head; c; c = c->next)
{
- rc = eval (c->expr, op2, &r);
+ if (c->expr->expr_type == EXPR_CONSTANT)
+ rc = eval (c->expr, op2, &r);
+ else
+ rc = reduce_binary_ac (eval, c->expr, op2, &r);
+
if (rc != ARITH_OK)
break;
for (c = head; c; c = c->next)
{
- rc = eval (op1, c->expr, &r);
+ if (c->expr->expr_type == EXPR_CONSTANT)
+ rc = eval (op1, c->expr, &r);
+ else
+ rc = reduce_binary_ca (eval, op1, c->expr, &r);
+
if (rc != ARITH_OK)
break;
}
+/* We need a forward declaration of reduce_binary. */
+static arith reduce_binary (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
+ gfc_expr *op1, gfc_expr *op2, gfc_expr **result);
+
+
static arith
reduce_binary_aa (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
gfc_expr *op1, gfc_expr *op2, gfc_expr **result)
rc = ARITH_OK;
d = op2->value.constructor;
- if (gfc_check_conformance ("Elemental binary operation", op1, op2)
+ if (gfc_check_conformance ("elemental binary operation", op1, op2)
!= SUCCESS)
rc = ARITH_INCOMMENSURATE;
else
break;
}
- rc = eval (c->expr, d->expr, &r);
+ rc = reduce_binary (eval, c->expr, d->expr, &r);
if (rc != ARITH_OK)
break;
unary = 0;
temp.ts.type = BT_LOGICAL;
temp.ts.kind = gfc_default_logical_kind;
+
+ /* If kind mismatch, exit and we'll error out later. */
+ if (op1->ts.kind != op2->ts.kind)
+ goto runtime;
+
break;
}
/* Character binary */
case INTRINSIC_CONCAT:
- if (op1->ts.type != BT_CHARACTER || op2->ts.type != BT_CHARACTER)
+ if (op1->ts.type != BT_CHARACTER || op2->ts.type != BT_CHARACTER
+ || op1->ts.kind != op2->ts.kind)
goto runtime;
temp.ts.type = BT_CHARACTER;
- temp.ts.kind = gfc_default_character_kind;
+ temp.ts.kind = op1->ts.kind;
unary = 0;
break;
gfc_expr *
gfc_parentheses (gfc_expr *op)
{
+ if (gfc_is_constant_expr (op))
+ return op;
+
return eval_intrinsic_f2 (INTRINSIC_PARENTHESES, gfc_arith_identity,
op, NULL);
}
gfc_typename (from), gfc_typename (to), where);
break;
case ARITH_OVERFLOW:
- gfc_error ("Arithmetic overflow converting %s to %s at %L",
+ gfc_error ("Arithmetic overflow converting %s to %s at %L. This check "
+ "can be disabled with the option -fno-range-check",
gfc_typename (from), gfc_typename (to), where);
break;
case ARITH_UNDERFLOW:
result->representation.string = gfc_getmem (result_len + 1);
memcpy (result->representation.string, src->representation.string,
- MIN (result_len, src_len));
+ MIN (result_len, src_len));
if (src_len < result_len)
memset (&result->representation.string[src_len], ' ', result_len - src_len);
result->where = src->where;
hollerith2representation (result, src);
- gfc_interpret_integer(kind, (unsigned char *) result->representation.string,
- result->representation.length, result->value.integer);
+ gfc_interpret_integer (kind, (unsigned char *) result->representation.string,
+ result->representation.length, result->value.integer);
return result;
}
result->where = src->where;
hollerith2representation (result, src);
- gfc_interpret_float(kind, (unsigned char *) result->representation.string,
- result->representation.length, result->value.real);
+ gfc_interpret_float (kind, (unsigned char *) result->representation.string,
+ result->representation.length, result->value.real);
return result;
}
result->where = src->where;
hollerith2representation (result, src);
- gfc_interpret_complex(kind, (unsigned char *) result->representation.string,
- result->representation.length, result->value.complex.r,
- result->value.complex.i);
+ gfc_interpret_complex (kind, (unsigned char *) result->representation.string,
+ result->representation.length, result->value.complex.r,
+ result->value.complex.i);
return result;
}
result->ts.type = BT_CHARACTER;
result->ts.kind = kind;
- result->value.character.string = result->representation.string;
result->value.character.length = result->representation.length;
+ result->value.character.string
+ = gfc_char_to_widechar (result->representation.string);
return result;
}
result->where = src->where;
hollerith2representation (result, src);
- gfc_interpret_logical(kind, (unsigned char *) result->representation.string,
- result->representation.length, &result->value.logical);
+ gfc_interpret_logical (kind, (unsigned char *) result->representation.string,
+ result->representation.length, &result->value.logical);
return result;
}
OSDN Git Service
