Hello world,
this patch fixes a 7/8/9 regression where we tried to accept invalid
code, which led to an ICE later on.
The patch is rather straightforward. The reason why I could not
use gfc_expr_attr is that it does not actually return the
flags the way they can be found in the original attributes;
for example, an expression containing a pointer attribute is
shown as having the target attribute, for reasons I cannot
fathom.
Regression-tested. OK for trunk and other open branches?
Regards
Thomas
2019-02-06 Thomas Koenig <tkoe...@gcc.gnu.org>
PR fortran/71237
* expr.c (gfc_check_assign): Add argument is_init_expr. If we are
looking at an init expression, issue error if the target is not a
TARGET and we are not looking at a procedure pointer.
* gfortran.h (gfc_check_assign): Add optional argument
is_init_expr.
2019-02-06 Thomas Koenig <tkoe...@gcc.gnu.org>
PR fortran/71237
* gfortran.dg/pointer_init_2.f90: Adjust error messages.
* gfortran.dg/pointer_init_6.f90: Likewise.
* gfortran.dg/pointer_init_9.f90: New test.
! { dg-do compile }
! PR 71237 - this used to ICE.
module data_mod
implicit none
type data_t
integer :: i
end type
type(data_t), pointer :: data
integer, pointer :: idata => data%i ! { dg-error "Pointer assignment target in initialization expression does not have the TARGET attribute" }
end module
Index: fortran/ChangeLog
===================================================================
--- fortran/ChangeLog (Revision 268501)
+++ fortran/ChangeLog (Arbeitskopie)
@@ -1,3 +1,11 @@
+2019-02-05 Thomas Koenig <tkoe...@gcc.gnu.org>
+
+ PR fortran/67679
+ Backport from trunk
+ * trans-array.c (gfc_array_allocate): For setting the bounds on
+ the new array, add a condition for a not previously allocated
+ variable.
+
2019-02-02 Dominique d'Humieres <domi...@gcc.gnu.org>
PR fortran/81344
Index: fortran/expr.c
===================================================================
--- fortran/expr.c (Revision 268432)
+++ fortran/expr.c (Arbeitskopie)
@@ -3682,7 +3682,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rval
bool
gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue,
- bool suppress_type_test)
+ bool suppress_type_test, bool is_init_expr)
{
symbol_attribute attr, lhs_attr;
gfc_ref *ref;
@@ -4124,12 +4124,36 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_ex
return false;
}
- if (!attr.target && !attr.pointer)
+ if (is_init_expr)
{
- gfc_error ("Pointer assignment target is neither TARGET "
- "nor POINTER at %L", &rvalue->where);
- return false;
+ gfc_symbol *sym;
+ bool target;
+
+ gcc_assert (rvalue->symtree);
+ sym = rvalue->symtree->n.sym;
+
+ if (sym->ts.type == BT_CLASS && sym->attr.class_ok)
+ target = CLASS_DATA (sym)->attr.target;
+ else
+ target = sym->attr.target;
+
+ if (!target && !proc_pointer)
+ {
+ gfc_error ("Pointer assignment target in initialization expression "
+ "does not have the TARGET attribute at %L",
+ &rvalue->where);
+ return false;
+ }
}
+ else
+ {
+ if (!attr.target && !attr.pointer)
+ {
+ gfc_error ("Pointer assignment target is neither TARGET "
+ "nor POINTER at %L", &rvalue->where);
+ return false;
+ }
+ }
if (is_pure && gfc_impure_variable (rvalue->symtree->n.sym))
{
@@ -4262,7 +4286,7 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_comp
}
if (pointer || proc_pointer)
- r = gfc_check_pointer_assign (&lvalue, rvalue);
+ r = gfc_check_pointer_assign (&lvalue, rvalue, false, true);
else
{
/* If a conversion function, e.g., __convert_i8_i4, was inserted
Index: fortran/gfortran.h
===================================================================
--- fortran/gfortran.h (Revision 268475)
+++ fortran/gfortran.h (Arbeitskopie)
@@ -3247,7 +3247,8 @@ int gfc_kind_max (gfc_expr *, gfc_expr *);
bool gfc_check_conformance (gfc_expr *, gfc_expr *, const char *, ...) ATTRIBUTE_PRINTF_3;
bool gfc_check_assign (gfc_expr *, gfc_expr *, int, bool c = true);
bool gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue,
- bool suppres_type_test = false);
+ bool suppres_type_test = false,
+ bool is_init_expr = false);
bool gfc_check_assign_symbol (gfc_symbol *, gfc_component *, gfc_expr *);
gfc_expr *gfc_build_default_init_expr (gfc_typespec *, locus *);
Index: testsuite/gfortran.dg/pointer_init_2.f90
===================================================================
--- testsuite/gfortran.dg/pointer_init_2.f90 (Revision 268432)
+++ testsuite/gfortran.dg/pointer_init_2.f90 (Arbeitskopie)
@@ -18,7 +18,7 @@ subroutine sub
integer, pointer :: dp0 => 13 ! { dg-error "Error in pointer initialization" }
integer, pointer :: dp1 => r ! { dg-error "Different types in pointer assignment" }
integer, pointer :: dp2 => v ! { dg-error "Different ranks in pointer assignment" }
- integer, pointer :: dp3 => i ! { dg-error "is neither TARGET nor POINTER" }
+ integer, pointer :: dp3 => i ! { dg-error "Pointer assignment target in initialization expression does not have the TARGET attribute" }
integer, pointer :: dp4 => j ! { dg-error "must have the SAVE attribute" }
integer, pointer :: dp5 => a ! { dg-error "must not be ALLOCATABLE" }
@@ -35,7 +35,7 @@ subroutine sub
end type t3
type t4
- integer, pointer :: dpc3 => i ! { dg-error "Pointer assignment target is neither TARGET nor POINTER" }
+ integer, pointer :: dpc3 => i ! { dg-error "Pointer assignment target in initialization expression does not have the TARGET attribute" }
end type t4
type t5
Index: testsuite/gfortran.dg/pointer_init_6.f90
===================================================================
--- testsuite/gfortran.dg/pointer_init_6.f90 (Revision 268432)
+++ testsuite/gfortran.dg/pointer_init_6.f90 (Arbeitskopie)
@@ -13,7 +13,7 @@ module m1
integer, target :: i
type(t), target :: x
integer, pointer :: p1 => i
- integer, pointer :: p2 => p1 ! { dg-error "must have the TARGET attribute" }
+ integer, pointer :: p2 => p1 ! { dg-error "Pointer assignment target in initialization expression does not have the TARGET attribute at" }
integer, pointer :: p3 => x%p ! { dg-error "must have the TARGET attribute" }
integer, pointer :: p4 => x%i
integer, pointer :: p5 => u ! { dg-error "has no IMPLICIT type" }
