OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/41922 (Diagnostic: No location shown for overlappingly initialized EQUIVALENCEd character vars)

Browse Source 
2016-07-30  Steven G. Kargl <kargl@gcc.gnu.org>

	PR fortran/41922
	* target-memory.c (expr_to_char): Pass in locus and use it in error
	messages.
	(gfc_merge_initializers): Ditto.
	* target-memory.h: Update prototype for gfc_merge_initializers ().
	* trans-common.c (get_init_field): Use the correct locus.

2016-07-30  Steven G. Kargl <kargl@gcc.gnu.org>

	PR fortran/41922
	* gfortran.dg/equiv_constraint_5.f90: Adjust the error message.
	* gfortran.dg/equiv_constraint_7.f90: Ditto.
	* gfortran.dg/pr41922.f90: New test.

From-SVN: r238915
This commit is contained in:
Steven G. Kargl 2016-07-31 01:51:37 +00:00
parent 01afb976de
commit 93cb9a5aa1
8 changed files with 52 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
gcc/fortran/ChangeLog
View File

@ -1,3 +1,12 @@
2016-07-30 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/41922
* target-memory.c (expr_to_char): Pass in locus and use it in error
messages.
(gfc_merge_initializers): Ditto.
* target-memory.h: Update prototype for gfc_merge_initializers ().
* trans-common.c (get_init_field): Use the correct locus.
2016-07-30 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/68566

23
gcc/fortran/target-memory.c
View File

@ -639,7 +639,8 @@ gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size,
error. */
static size_t
expr_to_char (gfc_expr *e, unsigned char *data, unsigned char *chk, size_t len)
expr_to_char (gfc_expr *e, locus *loc,
unsigned char *data, unsigned char *chk, size_t len)
{
int i;
int ptr;
@ -663,7 +664,7 @@ expr_to_char (gfc_expr *e, unsigned char *data, unsigned char *chk, size_t len)
continue;
ptr = TREE_INT_CST_LOW(DECL_FIELD_OFFSET(cmp->backend_decl))
+ TREE_INT_CST_LOW(DECL_FIELD_BIT_OFFSET(cmp->backend_decl))/8;
expr_to_char (c->expr, &data[ptr], &chk[ptr], len);
expr_to_char (c->expr, loc, &data[ptr], &chk[ptr], len);
}
return len;
}
@ -674,12 +675,16 @@ expr_to_char (gfc_expr *e, unsigned char *data, unsigned char *chk, size_t len)
buffer = (unsigned char*)alloca (len);
len = gfc_target_encode_expr (e, buffer, len);
for (i = 0; i < (int)len; i++)
for (i = 0; i < (int)len; i++)
{
if (chk[i] && (buffer[i] != data[i]))
{
gfc_error ("Overlapping unequal initializers in EQUIVALENCE "
"at %L", &e->where);
if (loc)
gfc_error ("Overlapping unequal initializers in EQUIVALENCE "
"at %L", loc);
else
gfc_error ("Overlapping unequal initializers in EQUIVALENCE "
"at %C");
return 0;
}
chk[i] = 0xFF;
@ -695,7 +700,8 @@ expr_to_char (gfc_expr *e, unsigned char *data, unsigned char *chk, size_t len)
the union declaration. */
size_t
gfc_merge_initializers (gfc_typespec ts, gfc_expr *e, unsigned char *data,
gfc_merge_initializers (gfc_typespec ts, gfc_expr *e, locus *loc,
unsigned char *data,
unsigned char *chk, size_t length)
{
size_t len = 0;
@ -705,8 +711,7 @@ gfc_merge_initializers (gfc_typespec ts, gfc_expr *e, unsigned char *data,
{
case EXPR_CONSTANT:
case EXPR_STRUCTURE:
len = expr_to_char (e, &data[0], &chk[0], length);
len = expr_to_char (e, loc, &data[0], &chk[0], length);
break;
case EXPR_ARRAY:
@ -718,7 +723,7 @@ gfc_merge_initializers (gfc_typespec ts, gfc_expr *e, unsigned char *data,
if (mpz_cmp_si (c->offset, 0) != 0)
len = elt_size * (size_t)mpz_get_si (c->offset);
len = len + gfc_merge_initializers (ts, c->expr, &data[len],
len = len + gfc_merge_initializers (ts, c->expr, loc, &data[len],
&chk[len], length - len);
}
break;

2
gcc/fortran/target-memory.h
View File

@ -44,7 +44,7 @@ int gfc_interpret_derived (unsigned char *, size_t, gfc_expr *);
int gfc_target_interpret_expr (unsigned char *, size_t, gfc_expr *, bool);
/* Merge overlapping equivalence initializers for trans-common.c. */
size_t gfc_merge_initializers (gfc_typespec, gfc_expr *,
size_t gfc_merge_initializers (gfc_typespec, gfc_expr *, locus *,
unsigned char *, unsigned char *,
size_t);

7
gcc/fortran/trans-common.c
View File

@ -532,10 +532,15 @@ get_init_field (segment_info *head, tree union_type, tree *field_init,
memset (chk, '\0', (size_t)length);
for (s = head; s; s = s->next)
if (s->sym->value)
gfc_merge_initializers (s->sym->ts, s->sym->value,
{
locus *loc = NULL;
if (s->sym->ns->equiv && s->sym->ns->equiv->eq)
loc = &s->sym->ns->equiv->eq->expr->where;
gfc_merge_initializers (s->sym->ts, s->sym->value, loc,
&data[s->offset],
&chk[s->offset],
(size_t)s->length);
}
for (i = 0; i < length; i++)
CONSTRUCTOR_APPEND_ELT (v, NULL, build_int_cst (type, data[i]));

7
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,10 @@
2016-07-30 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/41922
* gfortran.dg/equiv_constraint_5.f90: Adjust the error message.
* gfortran.dg/equiv_constraint_7.f90: Ditto.
* gfortran.dg/pr41922.f90: New test.
2016-07-30 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/68566

4
gcc/testsuite/gfortran.dg/equiv_constraint_5.f90
View File

@ -19,13 +19,13 @@
END TYPE T2
TYPE T3
sequence
integer :: i=2 ! { dg-error "Overlapping unequal initializers" }
integer :: i=2
END TYPE T3
TYPE(T1) :: a1
TYPE(T2) :: a2
TYPE(T3) :: a3
EQUIVALENCE (a1, a2)
EQUIVALENCE (a1, a3)
EQUIVALENCE (a1, a3) ! { dg-error "Overlapping unequal initializers" }
write(6, *) a1, a2, a3
END

4
gcc/testsuite/gfortran.dg/equiv_constraint_7.f90
View File

@ -5,7 +5,7 @@
! Started out being in BLOCK DATA; however, blockdata variables must be in
! COMMON and therefore cannot have F95 style initializers....
MODULE DATA
INTEGER :: I=1,J=2 ! { dg-error "Overlapping unequal initializers" }
EQUIVALENCE(I,J)
INTEGER :: I=1,J=2
EQUIVALENCE(I,J) ! { dg-error "Overlapping unequal initializers" }
END MODULE DATA
END

11
gcc/testsuite/gfortran.dg/pr41922.f90 Normal file
View File

@ -0,0 +1,11 @@
! { dg-do compile}
! { dg-options -std=gnu }
Subroutine RestoreR8Run()
Implicit NONE
Integer ISTORE
Real XSTORE
character CSTORE(8)
data cstore/8*' '/
data istore/0/
EQUIVALENCE (CSTORE(1),XSTORE,ISTORE) ! { dg-error "Overlapping unequal" }
end