From: Steven G. Kargl Date: Thu, 10 Jan 2019 18:45:38 +0000 (+0000) Subject: re PR fortran/86322 (ICE in reference_record with data statement) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=bebf94afe55f257942ca4bd378b4006f1f17a0c8;p=gcc.git re PR fortran/86322 (ICE in reference_record with data statement) 2019-01-10 Steven G. Kargl PR fortran/86322 * decl.c (top_var_list): Set locus of expr. (gfc_match_data): Detect pointer on non-rightmost part-refs. 2019-01-10 Steven G. Kargl PR fortran/86322 * gfortran.dg/pr86322_1.f90: New test. * gfortran.dg/pr86322_2.f90: Ditto. * gfortran.dg/pr86322_3.f90: Ditto. From-SVN: r267820 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d96f2c1ff2e..678970b4621 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2019-01-10 Steven G. Kargl + + PR fortran/86322 + * decl.c (top_var_list): Set locus of expr. + (gfc_match_data): Detect pointer on non-rightmost part-refs. + 2019-01-09 Steven G. Kargl PR fortran/88376 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 460c45db5dd..e5bfc3bd5a4 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -337,6 +337,8 @@ top_var_list (gfc_data *d) new_var = gfc_get_data_variable (); *new_var = var; + if (new_var->expr) + new_var->expr->where = gfc_current_locus; if (tail == NULL) d->var = new_var; @@ -597,6 +599,7 @@ gfc_match_data (void) { gfc_data *new_data; gfc_expr *e; + gfc_ref *ref; match m; /* Before parsing the rest of a DATA statement, check F2008:c1206. */ @@ -641,7 +644,7 @@ gfc_match_data (void) bool invalid; invalid = false; - for (gfc_ref *ref = e->ref; ref; ref = ref->next) + for (ref = e->ref; ref; ref = ref->next) if ((ref->type == REF_COMPONENT && ref->u.c.component->attr.allocatable) || (ref->type == REF_ARRAY @@ -655,6 +658,21 @@ gfc_match_data (void) "near %C in DATA statement"); goto cleanup; } + + /* F2008:C567 (R536) A data-i-do-object or a variable that appears + as a data-stmt-object shall not be an object designator in which + a pointer appears other than as the entire rightmost part-ref. */ + ref = e->ref; + if (e->symtree->n.sym->ts.type == BT_DERIVED + && e->symtree->n.sym->attr.pointer + && ref->type == REF_COMPONENT) + goto partref; + + for (; ref; ref = ref->next) + if (ref->type == REF_COMPONENT + && ref->u.c.component->attr.pointer + && ref->next) + goto partref; } m = top_val_list (new_data); @@ -681,6 +699,12 @@ gfc_match_data (void) return MATCH_YES; +partref: + + gfc_error ("part-ref with pointer attribute near %L is not " + "rightmost part-ref of data-stmt-object", + &e->where); + cleanup: set_in_match_data (false); gfc_free_data (new_data); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 6ac91eede53..157c37db2ec 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2019-01-10 Steven G. Kargl + + PR fortran/86322 + * gfortran.dg/pr86322_1.f90: New test. + * gfortran.dg/pr86322_2.f90: Ditto. + * gfortran.dg/pr86322_3.f90: Ditto. + 2019-01-10 Sudakshina Das * gcc.target/aarch64/bti-1.c: Exempt for ilp32. diff --git a/gcc/testsuite/gfortran.dg/pr86322_1.f90 b/gcc/testsuite/gfortran.dg/pr86322_1.f90 new file mode 100644 index 00000000000..48079ac7ecc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr86322_1.f90 @@ -0,0 +1,12 @@ +! { dg-do compile } +program foo + implicit none + type a + integer i + end type a + type(a), target, save :: b + type(a), pointer :: c + data b%i /42/ + data c%i /b%i/ ! { dg-error "is not rightmost part-ref" } + if (c%i == 42) c%i = 1 ! Unreachable +end program foo diff --git a/gcc/testsuite/gfortran.dg/pr86322_2.f90 b/gcc/testsuite/gfortran.dg/pr86322_2.f90 new file mode 100644 index 00000000000..fec17dbba60 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr86322_2.f90 @@ -0,0 +1,13 @@ +! { dg-do compile } +program bar + type a + integer :: i + end type a + type b + type(a),pointer :: j + end type b + integer, target, save :: k = 42 + type(b) x + data x%j%i/k/ ! { dg-error "is not rightmost part-ref" } + print *, x%j%i +end program bar diff --git a/gcc/testsuite/gfortran.dg/pr86322_3.f90 b/gcc/testsuite/gfortran.dg/pr86322_3.f90 new file mode 100644 index 00000000000..0bcb5fc6370 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr86322_3.f90 @@ -0,0 +1,13 @@ +! { dg-do run } +program bar + type a + integer, pointer :: i + end type a + type b + type(a) :: j + end type b + integer, target, save :: k = 42 + type(b) x + data x%j%i/k/ + if (x%j%i /= 42) stop 1 +end program bar