Dear All,
Sorry for breaking the thread on this one.
The patch below is OK for trunk, minus the fragment in
'get_declared_from_expr' from one of my patches :-)
Cheers
Paul
-----------------------------------
Rather simple patch.
Build and regtested on x86-64-linux.
OK for the trunk?
Tobias
2012-01-08 Tobias Burnus <bur...@net-b.de>
PR fortran/51652
* resolve.c (resolve_allocate_expr): For non-deferred char lengths,
check whether type-spec matches declaration.
2012-01-08 Tobias Burnus <bur...@net-b.de>
PR fortran/51652
* gfortran.dg/allocate_with_typespec_5.f90: New.
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (Revision 182995)
+++ gcc/fortran/resolve.c (Arbeitskopie)
@@ -5683,8 +5683,10 @@ get_declared_from_expr (gfc_ref **class_ref, gfc_r
}
}
- if (declared == NULL)
+ if (declared == NULL && e->expr_type == EXPR_VARIABLE)
declared = e->symtree->n.sym->ts.u.derived;
+ else
+ declared = e->ts.u.derived;
return declared;
}
@@ -6989,6 +6991,19 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code
goto failure;
}
+ if (code->ext.alloc.ts.type == BT_CHARACTER && !e->ts.deferred)
+ {
+ int cmp = gfc_dep_compare_expr (e->ts.u.cl->length,
+ code->ext.alloc.ts.u.cl->length);
+ if (cmp == 1 || cmp == -1 || cmp == -3)
+ {
+ gfc_error ("Allocating %s at %L with type-spec requires the same "
+ "character-length parameter as in the declaration",
+ sym->name, &e->where);
+ goto failure;
+ }
+ }
+
/* In the variable definition context checks, gfc_expr_attr is used
on the expression. This is fooled by the array specification
present in e, thus we have to eliminate that one temporarily. */
Index: gcc/testsuite/gfortran.dg/allocate_with_typespec_5.f90
===================================================================
--- gcc/testsuite/gfortran.dg/allocate_with_typespec_5.f90 (Revision 0)
+++ gcc/testsuite/gfortran.dg/allocate_with_typespec_5.f90 (Arbeitskopie)
@@ -0,0 +1,26 @@
+! { dg-do compile }
+!
+! PR fortran/51652
+!
+! Contributed by David Kinniburgh
+!
+module settings
+
+type keyword
+ character(60), allocatable :: c(:)
+end type keyword
+
+type(keyword) :: kw(10)
+
+contains
+
+subroutine save_kw
+ allocate(character(80) :: kw(1)%c(10)) ! { dg-error "with type-spec
requires the same character-length parameter" }
+end subroutine save_kw
+
+subroutine foo(n)
+ character(len=n+2), allocatable :: x
+ allocate (character(len=n+3) :: x) ! { dg-error "type-spec requires
the same character-length parameter" }
+end subroutine foo
+
+end module settings
