FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

gfortran.h (gfc_expr): Remove from_H, add "representation" struct.

Browse source 
* gfortran.h (gfc_expr): Remove from_H, add "representation"
struct.
* primary.c (match_hollerith_constant): Store the representation
of the Hollerith in representation, not in value.character.
* arith.c: Add dependency on target-memory.h.
(eval_intrinsic): Remove check for from_H.
(hollerith2representation): New function.
(gfc_hollerith2int): Determine value of the new constant.
(gfc_hollerith2real): Likewise.
(gfc_hollerith2complex): Likewise.
(gfc_hollerith2logical): Likewise.
(gfc_hollerith2character): Point both representation.string and
value.character.string at the value string.
* data.c (create_character_initializer): For BT_HOLLERITH
rvalues, get the value from the representation rather than
value.character.
* expr.c (free_expr0): Update handling of BT_HOLLERITH values
and values with representation.string.
(gfc_copy_expr): Likewise.
* intrinsic.c (do_simplify): Remove special treatement of
variables resulting from Hollerith constants.
* dump-parse-trees.c (gfc_show_expr): Update handling of
Holleriths.
* trans-const.c (gfc_conv_constant_to_tree): Replace from_H
check with check for representation.string; get Hollerith
representation from representation.string, not value.character.
* trans-expr.c (is_zero_initializer_p): Replace from_H check
with check for representation.string.
* trans-stmt.c (gfc_trans_integer_select): Use
gfc_conv_mpz_to_tree for case values, so as to avoid picking up
the memory representation if the case is given by a transfer
expression.
* target-memory.c (gfc_target_encode_expr): Use the known memory
representation rather than the value, if it exists.
(gfc_target_interpret_expr): Store the memory representation of
the interpreted expression as well as its value.
(interpret_integer): Move to gfc_interpret_integer, make
non-static.
(interpret_float): Move to gfc_interpret_float, make non-static.
(interpret_complex): Move to gfc_interpret_complex, make
non-static.
(interpret_logical): Move to gfc_interpret_logical, make
non-static.
(interpret_character): Move to gfc_interpret_character, make
non-static.
(interpret_derived): Move to gfc_interpret_derived, make
non-static.
* target-memory.h: Add prototypes for newly-exported
gfc_interpret_* functions.

From-SVN: r125135
This commit is contained in:
Brooks Moses 2007-05-28 18:20:29 +00:00 • committed by Brooks Moses
parent 0258dc3a2c
commit 20585ad66a
13 changed files with 287 additions and 172 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

52
gcc/fortran/ChangeLog
View file

@ -1,3 +1,55 @@
2007-05-27 Brooks Moses <brooks.moses@codesourcery.com>
* gfortran.h (gfc_expr): Remove from_H, add "representation"
struct.
* primary.c (match_hollerith_constant): Store the representation
of the Hollerith in representation, not in value.character.
* arith.c: Add dependency on target-memory.h.
(eval_intrinsic): Remove check for from_H.
(hollerith2representation): New function.
(gfc_hollerith2int): Determine value of the new constant.
(gfc_hollerith2real): Likewise.
(gfc_hollerith2complex): Likewise.
(gfc_hollerith2logical): Likewise.
(gfc_hollerith2character): Point both representation.string and
value.character.string at the value string.
* data.c (create_character_initializer): For BT_HOLLERITH
rvalues, get the value from the representation rather than
value.character.
* expr.c (free_expr0): Update handling of BT_HOLLERITH values
and values with representation.string.
(gfc_copy_expr): Likewise.
* intrinsic.c (do_simplify): Remove special treatement of
variables resulting from Hollerith constants.
* dump-parse-trees.c (gfc_show_expr): Update handling of
Holleriths.
* trans-const.c (gfc_conv_constant_to_tree): Replace from_H
check with check for representation.string; get Hollerith
representation from representation.string, not value.character.
* trans-expr.c (is_zero_initializer_p): Replace from_H check
with check for representation.string.
* trans-stmt.c (gfc_trans_integer_select): Use
gfc_conv_mpz_to_tree for case values, so as to avoid picking up
the memory representation if the case is given by a transfer
expression.
* target-memory.c (gfc_target_encode_expr): Use the known memory
representation rather than the value, if it exists.
(gfc_target_interpret_expr): Store the memory representation of
the interpreted expression as well as its value.
(interpret_integer): Move to gfc_interpret_integer, make
non-static.
(interpret_float): Move to gfc_interpret_float, make non-static.
(interpret_complex): Move to gfc_interpret_complex, make
non-static.
(interpret_logical): Move to gfc_interpret_logical, make
non-static.
(interpret_character): Move to gfc_interpret_character, make
non-static.
(interpret_derived): Move to gfc_interpret_derived, make
non-static.
* target-memory.h: Add prototypes for newly-exported
gfc_interpret_* functions.
2007-05-27 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/31812

127
gcc/fortran/arith.c
View file

@ -30,6 +30,7 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
#include "flags.h"
#include "gfortran.h"
#include "arith.h"
#include "target-memory.h"
/* MPFR does not have a direct replacement for mpz_set_f() from GMP.
It's easily implemented with a few calls though. */
@ -1613,17 +1614,15 @@ eval_intrinsic (gfc_intrinsic_op operator,
if (operator == INTRINSIC_POWER && op2->ts.type != BT_INTEGER)
goto runtime;
if (op1->from_H
|| (op1->expr_type != EXPR_CONSTANT
&& (op1->expr_type != EXPR_ARRAY
|| !gfc_is_constant_expr (op1) || !gfc_expanded_ac (op1))))
if (op1->expr_type != EXPR_CONSTANT
&& (op1->expr_type != EXPR_ARRAY
|| !gfc_is_constant_expr (op1) || !gfc_expanded_ac (op1)))
goto runtime;
if (op2 != NULL
&& (op2->from_H
|| (op2->expr_type != EXPR_CONSTANT
&& (op2->expr_type != EXPR_ARRAY
|| !gfc_is_constant_expr (op2) || !gfc_expanded_ac (op2)))))
&& op2->expr_type != EXPR_CONSTANT
&& (op2->expr_type != EXPR_ARRAY
|| !gfc_is_constant_expr (op2) || !gfc_expanded_ac (op2)))
goto runtime;
if (unary)
@ -2307,37 +2306,52 @@ gfc_int2log (gfc_expr *src, int kind)
}
/* Helper function to set the representation in a Hollerith conversion.
This assumes that the ts.type and ts.kind of the result have already
been set. */
static void
hollerith2representation (gfc_expr *result, gfc_expr *src)
{
int src_len, result_len;
src_len = src->representation.length;
result_len = gfc_target_expr_size (result);
if (src_len > result_len)
{
gfc_warning ("The Hollerith constant at %L is too long to convert to %s",
&src->where, gfc_typename(&result->ts));
}
result->representation.string = gfc_getmem (result_len + 1);
memcpy (result->representation.string, src->representation.string,
MIN (result_len, src_len));
if (src_len < result_len)
memset (&result->representation.string[src_len], ' ', result_len - src_len);
result->representation.string[result_len] = '\0'; /* For debugger */
result->representation.length = result_len;
}
/* Convert Hollerith to integer. The constant will be padded or truncated. */
gfc_expr *
gfc_hollerith2int (gfc_expr *src, int kind)
{
gfc_expr *result;
int len;
len = src->value.character.length;
result = gfc_get_expr ();
result->expr_type = EXPR_CONSTANT;
result->ts.type = BT_INTEGER;
result->ts.kind = kind;
result->where = src->where;
result->from_H = 1;
if (len > kind)
{
gfc_warning ("The Hollerith constant at %L is too long to convert to %s",
&src->where, gfc_typename(&result->ts));
}
result->value.character.string = gfc_getmem (kind + 1);
memcpy (result->value.character.string, src->value.character.string,
MIN (kind, len));
if (len < kind)
memset (&result->value.character.string[len], ' ', kind - len);
result->value.character.string[kind] = '\0'; /* For debugger */
result->value.character.length = kind;
hollerith2representation (result, src);
gfc_interpret_integer(kind, (unsigned char *) result->representation.string,
result->representation.length, result->value.integer);
return result;
}
@ -2358,22 +2372,10 @@ gfc_hollerith2real (gfc_expr *src, int kind)
result->ts.type = BT_REAL;
result->ts.kind = kind;
result->where = src->where;
result->from_H = 1;
if (len > kind)
{
gfc_warning ("The Hollerith constant at %L is too long to convert to %s",
&src->where, gfc_typename(&result->ts));
}
result->value.character.string = gfc_getmem (kind + 1);
memcpy (result->value.character.string, src->value.character.string,
MIN (kind, len));
if (len < kind)
memset (&result->value.character.string[len], ' ', kind - len);
result->value.character.string[kind] = '\0'; /* For debugger. */
result->value.character.length = kind;
hollerith2representation (result, src);
gfc_interpret_float(kind, (unsigned char *) result->representation.string,
result->representation.length, result->value.real);
return result;
}
@ -2394,24 +2396,11 @@ gfc_hollerith2complex (gfc_expr *src, int kind)
result->ts.type = BT_COMPLEX;
result->ts.kind = kind;
result->where = src->where;
result->from_H = 1;
kind = kind * 2;
if (len > kind)
{
gfc_warning ("The Hollerith constant at %L is too long to convert to %s",
&src->where, gfc_typename(&result->ts));
}
result->value.character.string = gfc_getmem (kind + 1);
memcpy (result->value.character.string, src->value.character.string,
MIN (kind, len));
if (len < kind)
memset (&result->value.character.string[len], ' ', kind - len);
result->value.character.string[kind] = '\0'; /* For debugger */
result->value.character.length = kind;
hollerith2representation (result, src);
gfc_interpret_complex(kind, (unsigned char *) result->representation.string,
result->representation.length, result->value.complex.r,
result->value.complex.i);
return result;
}
@ -2427,7 +2416,9 @@ gfc_hollerith2character (gfc_expr *src, int kind)
result = gfc_copy_expr (src);
result->ts.type = BT_CHARACTER;
result->ts.kind = kind;
result->from_H = 1;
result->value.character.string = result->representation.string;
result->value.character.length = result->representation.length;
return result;
}
@ -2448,22 +2439,10 @@ gfc_hollerith2logical (gfc_expr *src, int kind)
result->ts.type = BT_LOGICAL;
result->ts.kind = kind;
result->where = src->where;
result->from_H = 1;
if (len > kind)
{
gfc_warning ("The Hollerith constant at %L is too long to convert to %s",
&src->where, gfc_typename(&result->ts));
}
result->value.character.string = gfc_getmem (kind + 1);
memcpy (result->value.character.string, src->value.character.string,
MIN (kind, len));
if (len < kind)
memset (&result->value.character.string[len], ' ', kind - len);
result->value.character.string[kind] = '\0'; /* For debugger */
result->value.character.length = kind;
hollerith2representation (result, src);
gfc_interpret_logical(kind, (unsigned char *) result->representation.string,
result->representation.length, &result->value.logical);
return result;
}

21
gcc/fortran/data.c
View file

@ -154,7 +154,7 @@ create_character_intializer (gfc_expr *init, gfc_typespec *ts,
int len;
int start;
int end;
char *dest;
char *dest, *rvalue_string;
gfc_extract_int (ts->cl->length, &len);
@ -207,7 +207,17 @@ create_character_intializer (gfc_expr *init, gfc_typespec *ts,
}
/* Copy the initial value. */
len = rvalue->value.character.length;
if (rvalue->ts.type == BT_HOLLERITH)
{
len = rvalue->representation.length;
rvalue_string = rvalue->representation.string;
}
else
{
len = rvalue->value.character.length;
rvalue_string = rvalue->value.character.string;
}
if (len > end - start)
{
len = end - start;
@ -215,14 +225,17 @@ create_character_intializer (gfc_expr *init, gfc_typespec *ts,
"at %L", &rvalue->where);
}
memcpy (&dest[start], rvalue->value.character.string, len);
memcpy (&dest[start], rvalue_string, len);
/* Pad with spaces. Substrings will already be blanked. */
if (len < end - start && ref == NULL)
memset (&dest[start + len], ' ', end - (start + len));
if (rvalue->ts.type == BT_HOLLERITH)
init->from_H = 1;
{
init->representation.length = init->value.character.length;
init->representation.string = init->value.character.string;
}
return init;
}

32
gcc/fortran/dump-parse-tree.c
View file

@ -340,16 +340,6 @@ gfc_show_expr (gfc_expr *p)
break;
case EXPR_CONSTANT:
if (p->from_H || p->ts.type == BT_HOLLERITH)
{
gfc_status ("%dH", p->value.character.length);
c = p->value.character.string;
for (i = 0; i < p->value.character.length; i++, c++)
{
gfc_status_char (*c);
}
break;
}
switch (p->ts.type)
{
case BT_INTEGER:
@ -405,11 +395,33 @@ gfc_show_expr (gfc_expr *p)
gfc_status (")");
break;
case BT_HOLLERITH:
gfc_status ("%dH", p->representation.length);
c = p->representation.string;
for (i = 0; i < p->representation.length; i++, c++)
{
gfc_status_char (*c);
}
break;
default:
gfc_status ("???");
break;
}
if (p->representation.string)
{
gfc_status (" {");
c = p->representation.string;
for (i = 0; i < p->representation.length; i++, c++)
{
gfc_status ("%.2x", (unsigned int) *c);
if (i < p->representation.length - 1)
gfc_status_char (',');
}
gfc_status_char ('}');
}
break;
case EXPR_VARIABLE:

38
gcc/fortran/expr.c
View file

@ -140,12 +140,7 @@ free_expr0 (gfc_expr *e)
switch (e->expr_type)
{
case EXPR_CONSTANT:
if (e->from_H)
{
gfc_free (e->value.character.string);
break;
}
/* Free any parts of the value that need freeing. */
switch (e->ts.type)
{
case BT_INTEGER:
@ -157,7 +152,6 @@ free_expr0 (gfc_expr *e)
break;
case BT_CHARACTER:
case BT_HOLLERITH:
gfc_free (e->value.character.string);
break;
@ -170,6 +164,11 @@ free_expr0 (gfc_expr *e)
break;
}
/* Free the representation, except in character constants where it
is the same as value.character.string and thus already freed. */
if (e->representation.string && e->ts.type != BT_CHARACTER)
gfc_free (e->representation.string);
break;
case EXPR_OP:
@ -413,14 +412,16 @@ gfc_copy_expr (gfc_expr *p)
break;
case EXPR_CONSTANT:
if (p->from_H)
/* Copy target representation, if it exists. */
if (p->representation.string)
{
s = gfc_getmem (p->value.character.length + 1);
q->value.character.string = s;
s = gfc_getmem (p->representation.length + 1);
q->representation.string = s;
memcpy (s, p->value.character.string, p->value.character.length + 1);
break;
memcpy (s, p->representation.string, p->representation.length + 1);
}
/* Copy the values of any pointer components of p->value. */
switch (q->ts.type)
{
case BT_INTEGER:
@ -442,13 +443,18 @@ gfc_copy_expr (gfc_expr *p)
break;
case BT_CHARACTER:
case BT_HOLLERITH:
s = gfc_getmem (p->value.character.length + 1);
q->value.character.string = s;
if (p->representation.string)
q->value.character.string = q->representation.string;
else
{
s = gfc_getmem (p->value.character.length + 1);
q->value.character.string = s;
memcpy (s, p->value.character.string, p->value.character.length + 1);
memcpy (s, p->value.character.string, p->value.character.length + 1);
}
break;
case BT_HOLLERITH:
case BT_LOGICAL:
case BT_DERIVED:
break; /* Already done */

17
gcc/fortran/gfortran.h
View file

@ -1290,17 +1290,28 @@ typedef struct gfc_expr
locus where;
/* True if it is converted from Hollerith constant. */
unsigned int from_H : 1;
/* True if the expression is a call to a function that returns an array,
and if we have decided not to allocate temporary data for that array. */
unsigned int inline_noncopying_intrinsic : 1;
/* Used to quickly find a given constructor by it's offset. */
/* Used to quickly find a given constructor by its offset. */
splay_tree con_by_offset;
/* If an expression comes from a Hollerith constant or compile-time
evaluation of a transfer statement, it may have a prescribed target-
memory representation, and these cannot always be backformed from
the value. */
struct
{
int length;
char *string;
}
representation;
union
{
int logical;
mpz_t integer;
mpfr_t real;

10
gcc/fortran/intrinsic.c
View file

@ -3065,16 +3065,6 @@ 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)

19
gcc/fortran/primary.c
View file

@ -236,7 +236,6 @@ match_hollerith_constant (gfc_expr **result)
locus old_loc;
gfc_expr *e = NULL;
const char *msg;
char *buffer;
int num;
int i;
@ -270,18 +269,18 @@ match_hollerith_constant (gfc_expr **result)
}
else
{
buffer = (char *) gfc_getmem (sizeof(char) * num + 1);
for (i = 0; i < num; i++)
{
buffer[i] = gfc_next_char_literal (1);
}
gfc_free_expr (e);
e = gfc_constant_result (BT_HOLLERITH, gfc_default_character_kind,
&gfc_current_locus);
e->value.character.string = gfc_getmem (num + 1);
memcpy (e->value.character.string, buffer, num);
e->value.character.string[num] = '\0';
e->value.character.length = num;
e->representation.string = gfc_getmem (num + 1);
for (i = 0; i < num; i++)
{
e->representation.string[i] = gfc_next_char_literal (1);
}
e->representation.string[num] = '\0';
e->representation.length = num;
*result = e;
return MATCH_YES;
}

92
gcc/fortran/target-memory.c
View file

@ -220,6 +220,15 @@ gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer,
gcc_assert (source->expr_type == EXPR_CONSTANT
|| source->expr_type == EXPR_STRUCTURE);
/* If we already have a target-memory representation, we use that rather
than recreating one. */
if (source->representation.string)
{
memcpy (buffer, source->representation.string,
source->representation.length);
return source->representation.length;
}
switch (source->ts.type)
{
case BT_INTEGER:
@ -289,8 +298,8 @@ interpret_array (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
}
static int
interpret_integer (int kind, unsigned char *buffer, size_t buffer_size,
int
gfc_interpret_integer (int kind, unsigned char *buffer, size_t buffer_size,
mpz_t integer)
{
mpz_init (integer);
@ -301,8 +310,8 @@ interpret_integer (int kind, unsigned char *buffer, size_t buffer_size,
}
static int
interpret_float (int kind, unsigned char *buffer, size_t buffer_size,
int
gfc_interpret_float (int kind, unsigned char *buffer, size_t buffer_size,
mpfr_t real)
{
mpfr_init (real);
@ -314,19 +323,19 @@ interpret_float (int kind, unsigned char *buffer, size_t buffer_size,
}
static int
interpret_complex (int kind, unsigned char *buffer, size_t buffer_size,
int
gfc_interpret_complex (int kind, unsigned char *buffer, size_t buffer_size,
mpfr_t real, mpfr_t imaginary)
{
int size;
size = interpret_float (kind, &buffer[0], buffer_size, real);
size += interpret_float (kind, &buffer[size], buffer_size - size, imaginary);
size = gfc_interpret_float (kind, &buffer[0], buffer_size, real);
size += gfc_interpret_float (kind, &buffer[size], buffer_size - size, imaginary);
return size;
}
static int
interpret_logical (int kind, unsigned char *buffer, size_t buffer_size,
int
gfc_interpret_logical (int kind, unsigned char *buffer, size_t buffer_size,
int *logical)
{
tree t = native_interpret_expr (gfc_get_logical_type (kind), buffer,
@ -337,8 +346,8 @@ interpret_logical (int kind, unsigned char *buffer, size_t buffer_size,
}
static int
interpret_character (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
int
gfc_interpret_character (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
{
if (result->ts.cl && result->ts.cl->length)
result->value.character.length =
@ -355,8 +364,8 @@ interpret_character (unsigned char *buffer, size_t buffer_size, gfc_expr *result
}
static int
interpret_derived (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
int
gfc_interpret_derived (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
{
gfc_component *cmp;
gfc_constructor *head = NULL, *tail = NULL;
@ -428,24 +437,55 @@ gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size,
switch (result->ts.type)
{
case BT_INTEGER:
return interpret_integer (result->ts.kind, buffer, buffer_size,
result->value.integer);
result->representation.length =
gfc_interpret_integer (result->ts.kind, buffer, buffer_size,
result->value.integer);
break;
case BT_REAL:
return interpret_float (result->ts.kind, buffer, buffer_size,
result->value.real);
result->representation.length =
gfc_interpret_float (result->ts.kind, buffer, buffer_size,
result->value.real);
break;
case BT_COMPLEX:
return interpret_complex (result->ts.kind, buffer, buffer_size,
result->value.complex.r,
result->value.complex.i);
result->representation.length =
gfc_interpret_complex (result->ts.kind, buffer, buffer_size,
result->value.complex.r,
result->value.complex.i);
break;
case BT_LOGICAL:
return interpret_logical (result->ts.kind, buffer, buffer_size,
&result->value.logical);
result->representation.length =
gfc_interpret_logical (result->ts.kind, buffer, buffer_size,
&result->value.logical);
break;
case BT_CHARACTER:
return interpret_character (buffer, buffer_size, result);
result->representation.length =
gfc_interpret_character (buffer, buffer_size, result);
break;
case BT_DERIVED:
return interpret_derived (buffer, buffer_size, result);
result->representation.length =
gfc_interpret_derived (buffer, buffer_size, result);
break;
default:
gfc_internal_error ("Invalid expression in gfc_target_interpret_expr.");
break;
}
return 0;
if (result->ts.type == BT_CHARACTER)
result->representation.string = result->value.character.string;
else
{
result->representation.string =
gfc_getmem (result->representation.length + 1);
memcpy (result->representation.string, buffer,
result->representation.length);
result->representation.string[result->representation.length] = '\0';
}
return result->representation.length;
}

7
gcc/fortran/target-memory.h
View file

@ -32,6 +32,13 @@ size_t gfc_target_expr_size (gfc_expr *);
int gfc_target_encode_expr (gfc_expr *, unsigned char *, size_t);
/* Read a target buffer into a constant expression. */
int gfc_interpret_integer (int, unsigned char *, size_t, mpz_t);
int gfc_interpret_float (int, unsigned char *, size_t, mpfr_t);
int gfc_interpret_complex (int, unsigned char *, size_t, mpfr_t, mpfr_t);
int gfc_interpret_logical (int, unsigned char *, size_t, int *);
int gfc_interpret_character (unsigned char *, size_t, gfc_expr *);
int gfc_interpret_derived (unsigned char *, size_t, gfc_expr *);
int gfc_target_interpret_expr (unsigned char *, size_t, gfc_expr *);
#endif /* GFC_TARGET_MEMORY_H */

33
gcc/fortran/trans-const.c
View file

@ -209,45 +209,45 @@ gfc_conv_constant_to_tree (gfc_expr * expr)
{
gcc_assert (expr->expr_type == EXPR_CONSTANT);
/* If it is converted from Hollerith constant, we build string constant
and VIEW_CONVERT to its type. */
/* If it is has a prescribed memory representation, we build a string
constant and VIEW_CONVERT to its type. */
switch (expr->ts.type)
{
case BT_INTEGER:
if (expr->from_H)
if (expr->representation.string)
return build1 (VIEW_CONVERT_EXPR,
gfc_get_int_type (expr->ts.kind),
gfc_build_string_const (expr->value.character.length,
expr->value.character.string));
gfc_build_string_const (expr->representation.length,
expr->representation.string));
else
return gfc_conv_mpz_to_tree (expr->value.integer, expr->ts.kind);
case BT_REAL:
if (expr->from_H)
if (expr->representation.string)
return build1 (VIEW_CONVERT_EXPR,
gfc_get_real_type (expr->ts.kind),
gfc_build_string_const (expr->value.character.length,
expr->value.character.string));
gfc_build_string_const (expr->representation.length,
expr->representation.string));
else
return gfc_conv_mpfr_to_tree (expr->value.real, expr->ts.kind);
case BT_LOGICAL:
if (expr->from_H)
if (expr->representation.string)
return build1 (VIEW_CONVERT_EXPR,
gfc_get_logical_type (expr->ts.kind),
gfc_build_string_const (expr->value.character.length,
expr->value.character.string));
gfc_build_string_const (expr->representation.length,
expr->representation.string));
else
return build_int_cst (gfc_get_logical_type (expr->ts.kind),
expr->value.logical);
case BT_COMPLEX:
if (expr->from_H)
if (expr->representation.string)
return build1 (VIEW_CONVERT_EXPR,
gfc_get_complex_type (expr->ts.kind),
gfc_build_string_const (expr->value.character.length,
expr->value.character.string));
gfc_build_string_const (expr->representation.length,
expr->representation.string));
else
{
tree real = gfc_conv_mpfr_to_tree (expr->value.complex.r,
@ -260,10 +260,13 @@ gfc_conv_constant_to_tree (gfc_expr * expr)
}
case BT_CHARACTER:
case BT_HOLLERITH:
return gfc_build_string_const (expr->value.character.length,
expr->value.character.string);
case BT_HOLLERITH:
return gfc_build_string_const (expr->representation.length,
expr->representation.string);
default:
fatal_error ("gfc_conv_constant_to_tree(): invalid type: %s",
gfc_typename (&expr->ts));

5
gcc/fortran/trans-expr.c
View file

@ -3567,8 +3567,9 @@ is_zero_initializer_p (gfc_expr * expr)
{
if (expr->expr_type != EXPR_CONSTANT)
return false;
/* We ignore Hollerith constants for the time being. */
if (expr->from_H)
/* We ignore constants with prescribed memory representations for now. */
if (expr->representation.string)
return false;
switch (expr->ts.type)

6
gcc/fortran/trans-stmt.c
View file

@ -1139,7 +1139,8 @@ gfc_trans_integer_select (gfc_code * code)
if (cp->low)
{
low = gfc_conv_constant_to_tree (cp->low);
low = gfc_conv_mpz_to_tree (cp->low->value.integer,
cp->low->ts.kind);
/* If there's only a lower bound, set the high bound to the
maximum value of the case expression. */
@ -1169,7 +1170,8 @@ gfc_trans_integer_select (gfc_code * code)
|| (cp->low
&& mpz_cmp (cp->low->value.integer,
cp->high->value.integer) != 0))
high = gfc_conv_constant_to_tree (cp->high);
high = gfc_conv_mpz_to_tree (cp->high->value.integer,
cp->high->ts.kind);
/* Unbounded case. */
if (!cp->low)