Commit 13051352 by Fritz Reese Committed by Fritz Reese

re PR fortran/82886 (ICE with -finit-derived in gfc_conv_expr, at fortran/trans-expr.c:7807)

2017-11-10  Fritz Reese <fritzoreese@gmail.com>

    PR fortran/82886

    gcc/fortran/ChangeLog:

	PR fortran/82886
	* gfortran.h (gfc_build_init_expr): New prototype.
	* invoke.texi (finit-derived): Update documentation.
	* expr.c (gfc_build_init_expr): New, from gfc_build_default_init_expr.
	(gfc_build_default_init_expr): Redirect to gfc_build_init_expr(,,false)
	(component_initializer): Force building initializers using
	gfc_build_init_expr(,,true).

    gcc/testsuite/ChangeLog:

	PR fortran/82886
	* gfortran.dg/init_flag_16.f03: New testcase.

From-SVN: r254648
parent 2392736c
2017-11-10 Fritz Reese <fritzoreese@gmail.com>
PR fortran/82886
* gfortran.h (gfc_build_init_expr): New prototype.
* invoke.texi (finit-derived): Update documentation.
* expr.c (gfc_build_init_expr): New, from gfc_build_default_init_expr.
(gfc_build_default_init_expr): Redirect to gfc_build_init_expr(,,false)
(component_initializer): Force building initializers using
gfc_build_init_expr(,,true).
2017-11-10 Martin Sebor <msebor@redhat.com> 2017-11-10 Martin Sebor <msebor@redhat.com>
PR c/81117 PR c/81117
......
...@@ -4013,13 +4013,22 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_component *comp, gfc_expr *rvalue) ...@@ -4013,13 +4013,22 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_component *comp, gfc_expr *rvalue)
return true; return true;
} }
/* Invoke gfc_build_init_expr to create an initializer expression, but do not
* require that an expression be built. */
gfc_expr *
gfc_build_default_init_expr (gfc_typespec *ts, locus *where)
{
return gfc_build_init_expr (ts, where, false);
}
/* Build an initializer for a local integer, real, complex, logical, or /* Build an initializer for a local integer, real, complex, logical, or
character variable, based on the command line flags finit-local-zero, character variable, based on the command line flags finit-local-zero,
finit-integer=, finit-real=, finit-logical=, and finit-character=. */ finit-integer=, finit-real=, finit-logical=, and finit-character=.
With force, an initializer is ALWAYS generated. */
gfc_expr * gfc_expr *
gfc_build_default_init_expr (gfc_typespec *ts, locus *where) gfc_build_init_expr (gfc_typespec *ts, locus *where, bool force)
{ {
int char_len; int char_len;
gfc_expr *init_expr; gfc_expr *init_expr;
...@@ -4028,13 +4037,24 @@ gfc_build_default_init_expr (gfc_typespec *ts, locus *where) ...@@ -4028,13 +4037,24 @@ gfc_build_default_init_expr (gfc_typespec *ts, locus *where)
/* Try to build an initializer expression. */ /* Try to build an initializer expression. */
init_expr = gfc_get_constant_expr (ts->type, ts->kind, where); init_expr = gfc_get_constant_expr (ts->type, ts->kind, where);
/* If we want to force generation, make sure we default to zero. */
gfc_init_local_real init_real = flag_init_real;
int init_logical = gfc_option.flag_init_logical;
if (force)
{
if (init_real == GFC_INIT_REAL_OFF)
init_real = GFC_INIT_REAL_ZERO;
if (init_logical == GFC_INIT_LOGICAL_OFF)
init_logical = GFC_INIT_LOGICAL_FALSE;
}
/* We will only initialize integers, reals, complex, logicals, and /* We will only initialize integers, reals, complex, logicals, and
characters, and only if the corresponding command-line flags characters, and only if the corresponding command-line flags
were set. Otherwise, we free init_expr and return null. */ were set. Otherwise, we free init_expr and return null. */
switch (ts->type) switch (ts->type)
{ {
case BT_INTEGER: case BT_INTEGER:
if (gfc_option.flag_init_integer != GFC_INIT_INTEGER_OFF) if (force || gfc_option.flag_init_integer != GFC_INIT_INTEGER_OFF)
mpz_set_si (init_expr->value.integer, mpz_set_si (init_expr->value.integer,
gfc_option.flag_init_integer_value); gfc_option.flag_init_integer_value);
else else
...@@ -4045,7 +4065,7 @@ gfc_build_default_init_expr (gfc_typespec *ts, locus *where) ...@@ -4045,7 +4065,7 @@ gfc_build_default_init_expr (gfc_typespec *ts, locus *where)
break; break;
case BT_REAL: case BT_REAL:
switch (flag_init_real) switch (init_real)
{ {
case GFC_INIT_REAL_SNAN: case GFC_INIT_REAL_SNAN:
init_expr->is_snan = 1; init_expr->is_snan = 1;
...@@ -4074,7 +4094,7 @@ gfc_build_default_init_expr (gfc_typespec *ts, locus *where) ...@@ -4074,7 +4094,7 @@ gfc_build_default_init_expr (gfc_typespec *ts, locus *where)
break; break;
case BT_COMPLEX: case BT_COMPLEX:
switch (flag_init_real) switch (init_real)
{ {
case GFC_INIT_REAL_SNAN: case GFC_INIT_REAL_SNAN:
init_expr->is_snan = 1; init_expr->is_snan = 1;
...@@ -4106,9 +4126,9 @@ gfc_build_default_init_expr (gfc_typespec *ts, locus *where) ...@@ -4106,9 +4126,9 @@ gfc_build_default_init_expr (gfc_typespec *ts, locus *where)
break; break;
case BT_LOGICAL: case BT_LOGICAL:
if (gfc_option.flag_init_logical == GFC_INIT_LOGICAL_FALSE) if (init_logical == GFC_INIT_LOGICAL_FALSE)
init_expr->value.logical = 0; init_expr->value.logical = 0;
else if (gfc_option.flag_init_logical == GFC_INIT_LOGICAL_TRUE) else if (init_logical == GFC_INIT_LOGICAL_TRUE)
init_expr->value.logical = 1; init_expr->value.logical = 1;
else else
{ {
...@@ -4120,7 +4140,7 @@ gfc_build_default_init_expr (gfc_typespec *ts, locus *where) ...@@ -4120,7 +4140,7 @@ gfc_build_default_init_expr (gfc_typespec *ts, locus *where)
case BT_CHARACTER: case BT_CHARACTER:
/* For characters, the length must be constant in order to /* For characters, the length must be constant in order to
create a default initializer. */ create a default initializer. */
if (gfc_option.flag_init_character == GFC_INIT_CHARACTER_ON if ((force || gfc_option.flag_init_character == GFC_INIT_CHARACTER_ON)
&& ts->u.cl->length && ts->u.cl->length
&& ts->u.cl->length->expr_type == EXPR_CONSTANT) && ts->u.cl->length->expr_type == EXPR_CONSTANT)
{ {
...@@ -4136,7 +4156,8 @@ gfc_build_default_init_expr (gfc_typespec *ts, locus *where) ...@@ -4136,7 +4156,8 @@ gfc_build_default_init_expr (gfc_typespec *ts, locus *where)
gfc_free_expr (init_expr); gfc_free_expr (init_expr);
init_expr = NULL; init_expr = NULL;
} }
if (!init_expr && gfc_option.flag_init_character == GFC_INIT_CHARACTER_ON if (!init_expr
&& (force || gfc_option.flag_init_character == GFC_INIT_CHARACTER_ON)
&& ts->u.cl->length && flag_max_stack_var_size != 0) && ts->u.cl->length && flag_max_stack_var_size != 0)
{ {
gfc_actual_arglist *arg; gfc_actual_arglist *arg;
...@@ -4391,7 +4412,8 @@ component_initializer (gfc_typespec *ts, gfc_component *c, bool generate) ...@@ -4391,7 +4412,8 @@ component_initializer (gfc_typespec *ts, gfc_component *c, bool generate)
/* Treat simple components like locals. */ /* Treat simple components like locals. */
else else
{ {
init = gfc_build_default_init_expr (&c->ts, &c->loc); /* We MUST give an initializer, so force generation. */
init = gfc_build_init_expr (&c->ts, &c->loc, true);
gfc_apply_init (&c->ts, &c->attr, init); gfc_apply_init (&c->ts, &c->attr, init);
} }
......
...@@ -3174,6 +3174,7 @@ bool gfc_check_pointer_assign (gfc_expr *, gfc_expr *); ...@@ -3174,6 +3174,7 @@ bool gfc_check_pointer_assign (gfc_expr *, gfc_expr *);
bool gfc_check_assign_symbol (gfc_symbol *, gfc_component *, gfc_expr *); bool gfc_check_assign_symbol (gfc_symbol *, gfc_component *, gfc_expr *);
gfc_expr *gfc_build_default_init_expr (gfc_typespec *, locus *); gfc_expr *gfc_build_default_init_expr (gfc_typespec *, locus *);
gfc_expr *gfc_build_init_expr (gfc_typespec *, locus *, bool);
void gfc_apply_init (gfc_typespec *, symbol_attribute *, gfc_expr *); void gfc_apply_init (gfc_typespec *, symbol_attribute *, gfc_expr *);
bool gfc_has_default_initializer (gfc_symbol *); bool gfc_has_default_initializer (gfc_symbol *);
gfc_expr *gfc_default_initializer (gfc_typespec *); gfc_expr *gfc_default_initializer (gfc_typespec *);
......
...@@ -1714,9 +1714,14 @@ initialization options are provided by the ...@@ -1714,9 +1714,14 @@ initialization options are provided by the
the real and imaginary parts of local @code{COMPLEX} variables), the real and imaginary parts of local @code{COMPLEX} variables),
@option{-finit-logical=@var{<true|false>}}, and @option{-finit-logical=@var{<true|false>}}, and
@option{-finit-character=@var{n}} (where @var{n} is an ASCII character @option{-finit-character=@var{n}} (where @var{n} is an ASCII character
value) options. Components of derived type variables will be initialized value) options.
according to these flags only with @option{-finit-derived}. These options do
not initialize With @option{-finit-derived}, components of derived type variables will be
initialized according to these flags. Components whose type is not covered by
an explicit @option{-finit-*} flag will be treated as described above with
@option{-finit-local-zero}.
These options do not initialize
@itemize @bullet @itemize @bullet
@item @item
objects with the POINTER attribute objects with the POINTER attribute
......
2017-11-10 Fritz Reese <fritzoreese@gmail.com>
PR fortran/82886
* gfortran.dg/init_flag_16.f03: New testcase.
2017-11-10 Michael Meissner <meissner@linux.vnet.ibm.com> 2017-11-10 Michael Meissner <meissner@linux.vnet.ibm.com>
* gcc.target/powerpc/p9-xxbr-3.c: New test. * gcc.target/powerpc/p9-xxbr-3.c: New test.
......
! { dg-do compile }
! { dg-options "-finit-derived" }
!
! PR fortran/82886
!
! Test a regression which caused an ICE when -finit-derived was given without
! other -finit-* flags, especially for derived-type components with potentially
! hidden basic integer components.
!
program pr82886
use, intrinsic :: iso_c_binding, only: c_ptr, c_null_ptr
type t
type(c_ptr) :: my_c_ptr
end type
contains
subroutine sub0() bind(c)
type(t), target :: my_f90_type
my_f90_type%my_c_ptr = c_null_ptr
end subroutine
end
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment