+2008-01-16 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/34796
+ * interface.c (compare_parameter): Allow AS_DEFERRED array
+ elements and reject attr.pointer array elemenents.
+ (get_expr_storage_size): Return storage size of elements of
+ assumed-shape and pointer arrays.
+
2008-01-15 Sebastian Pop <sebastian.pop@amd.com>
* f95-lang.c (gfc_init_builtin_functions): Initialize GOMP builtins
&& (ref == NULL
|| (actual->expr_type == EXPR_VARIABLE
&& (actual->symtree->n.sym->as->type == AS_ASSUMED_SHAPE
- || actual->symtree->n.sym->as->type == AS_DEFERRED))))
+ || actual->symtree->n.sym->attr.pointer))))
{
if (where && (gfc_option.allow_std & GFC_STD_F2003) == 0)
{
if (actual->expr_type == EXPR_VARIABLE
&& actual->symtree->n.sym->as
&& (actual->symtree->n.sym->as->type == AS_ASSUMED_SHAPE
- || actual->symtree->n.sym->as->type == AS_DEFERRED))
+ || actual->symtree->n.sym->attr.pointer))
{
if (where)
gfc_error ("Element of assumed-shaped array passed to dummy "
{
int i;
long int strlen, elements;
+ long int substrlen = 0;
gfc_ref *ref;
if (e == NULL)
for (ref = e->ref; ref; ref = ref->next)
{
+ if (ref->type == REF_SUBSTRING && ref->u.ss.start
+ && ref->u.ss.start->expr_type == EXPR_CONSTANT)
+ {
+ int len = strlen;
+ if (ref->u.ss.end && ref->u.ss.end->expr_type == EXPR_CONSTANT)
+ len = mpz_get_ui (ref->u.ss.end->value.integer);
+ substrlen = len - mpz_get_ui (ref->u.ss.start->value.integer) + 1;
+ continue;
+ }
+
if (ref->type == REF_ARRAY && ref->u.ar.type == AR_SECTION
&& ref->u.ar.start && ref->u.ar.end && ref->u.ar.stride
&& ref->u.ar.as->upper)
else
return 0;
}
+ else if (ref->type == REF_ARRAY && ref->u.ar.type == AR_ELEMENT
+ && e->expr_type == EXPR_VARIABLE
+ && (e->symtree->n.sym->as->type == AS_ASSUMED_SHAPE
+ || e->symtree->n.sym->attr.pointer))
+ elements = 1;
else
/* TODO: Determine the number of remaining elements in the element
- sequence for array element designators.
+ sequence for array element designators. See PR 32616.
See also get_array_index in data.c. */
return 0;
}
+ if (substrlen)
+ return elements*substrlen;
+
return elements*strlen;
}
+2008-01-16 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/34796
+ * gfortran.dg/argument_checking_13.f90: New.
+ * gfortran.dg/argument_checking_14.f90: New.
+
2008-01-15 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/34671
--- /dev/null
+! { dg-do compile }
+!
+! PR fortran/34796
+!
+! Argument checks:
+! - elements of deferred-shape arrays (= non-dummies) are allowed
+! as the memory is contiguous
+! - while assumed-shape arrays (= dummy arguments) and pointers are
+! not (strides can make them non-contiguous)
+! and
+! - if the memory is non-contigous, character arguments have as
+! storage size only the size of the element itself, check for
+! too short actual arguments.
+!
+subroutine test1(assumed_sh_dummy, pointer_dummy)
+implicit none
+interface
+ subroutine rlv1(y)
+ real :: y(3)
+ end subroutine rlv1
+end interface
+
+real :: assumed_sh_dummy(:,:,:)
+real, pointer :: pointer_dummy(:,:,:)
+
+real, allocatable :: deferred(:,:,:)
+real, pointer :: ptr(:,:,:)
+call rlv1(deferred(1,1,1)) ! valid since contiguous
+call rlv1(ptr(1,1,1)) ! { dg-error "Element of assumed-shaped array" }
+call rlv1(assumed_sh_dummy(1,1,1)) ! { dg-error "Element of assumed-shaped array" }
+call rlv1(pointer_dummy(1,1,1)) ! { dg-error "Element of assumed-shaped array" }
+end
+
+subroutine test2(assumed_sh_dummy, pointer_dummy)
+implicit none
+interface
+ subroutine rlv2(y)
+ character :: y(3)
+ end subroutine rlv2
+end interface
+
+character(3) :: assumed_sh_dummy(:,:,:)
+character(3), pointer :: pointer_dummy(:,:,:)
+
+character(3), allocatable :: deferred(:,:,:)
+character(3), pointer :: ptr(:,:,:)
+call rlv2(deferred(1,1,1)) ! Valid since contiguous
+call rlv2(ptr(1,1,1)) ! Valid F2003
+call rlv2(assumed_sh_dummy(1,1,1)) ! Valid F2003
+call rlv2(pointer_dummy(1,1,1)) ! Valid F2003
+
+! The following is kind of ok: The memory access it valid
+! We warn nonetheless as the result is not what is intented
+! and also formally wrong.
+! Using (1:string_length) would be ok.
+call rlv2(ptr(1,1,1)(1:1)) ! { dg-warning "contains too few elements" }
+call rlv2(assumed_sh_dummy(1,1,1)(1:2)) ! { dg-warning "contains too few elements" }
+call rlv2(pointer_dummy(1,1,1)(1:3)) ! Valid F2003
+end
+
+subroutine test3(assumed_sh_dummy, pointer_dummy)
+implicit none
+interface
+ subroutine rlv3(y)
+ character :: y(3)
+ end subroutine rlv3
+end interface
+
+character(2) :: assumed_sh_dummy(:,:,:)
+character(2), pointer :: pointer_dummy(:,:,:)
+
+character(2), allocatable :: deferred(:,:,:)
+character(2), pointer :: ptr(:,:,:)
+call rlv3(deferred(1,1,1)) ! Valid since contiguous
+call rlv3(ptr(1,1,1)) ! { dg-warning "contains too few elements" }
+call rlv3(assumed_sh_dummy(1,1,1)) ! { dg-warning "contains too few elements" }
+call rlv3(pointer_dummy(1,1,1)) ! { dg-warning "contains too few elements" }
+
+call rlv3(deferred(1,1,1)(1:2)) ! Valid since contiguous
+call rlv3(ptr(1,1,1)(1:2)) ! { dg-warning "contains too few elements" }
+call rlv3(assumed_sh_dummy(1,1,1)(1:2)) ! { dg-warning "contains too few elements" }
+call rlv3(pointer_dummy(1,1,1)(1:2)) ! { dg-warning "contains too few elements" }
+end
--- /dev/null
+! { dg-do compile }
+! { dg-options "-std=f95" }
+!
+! PR fortran/34796
+!
+! This checks for Fortran 2003 extensions.
+!
+! Argument checks:
+! - elements of deferred-shape arrays (= non-dummies) are allowed
+! as the memory is contiguous
+! - while assumed-shape arrays (= dummy arguments) and pointers are
+! not (strides can make them non-contiguous)
+! and
+! - if the memory is non-contigous, character arguments have as
+! storage size only the size of the element itself, check for
+! too short actual arguments.
+!
+subroutine test2(assumed_sh_dummy, pointer_dummy)
+implicit none
+interface
+ subroutine rlv2(y)
+ character :: y(3)
+ end subroutine rlv2
+end interface
+
+character(3) :: assumed_sh_dummy(:,:,:)
+character(3), pointer :: pointer_dummy(:,:,:)
+
+character(3), allocatable :: deferred(:,:,:)
+character(3), pointer :: ptr(:,:,:)
+call rlv2(deferred(1,1,1)) ! Valid since contiguous
+call rlv2(ptr(1,1,1)) ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+call rlv2(assumed_sh_dummy(1,1,1)) ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+call rlv2(pointer_dummy(1,1,1)) ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+
+! The following is kind of ok: The memory access it valid
+! We warn nonetheless as the result is not what is intented
+! and also formally wrong.
+! Using (1:string_length) would be ok.
+call rlv2(deferred(1,1,1)(1:3)) ! OK
+call rlv2(ptr(1,1,1)(1:1)) ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+call rlv2(assumed_sh_dummy(1,1,1)(1:2)) ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+call rlv2(pointer_dummy(1,1,1)(1:3)) ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+end
+
+subroutine test3(assumed_sh_dummy, pointer_dummy)
+implicit none
+interface
+ subroutine rlv3(y)
+ character :: y(2)
+ end subroutine rlv3
+end interface
+
+character(2) :: assumed_sh_dummy(:,:,:)
+character(2), pointer :: pointer_dummy(:,:,:)
+
+character(2), allocatable :: deferred(:,:,:)
+character(2), pointer :: ptr(:,:,:)
+call rlv3(deferred(1,1,1)) ! Valid since contiguous
+call rlv3(ptr(1,1,1)) ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+call rlv3(assumed_sh_dummy(1,1,1)) ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+call rlv3(pointer_dummy(1,1,1)) ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+
+call rlv3(deferred(1,1,1)(1:2)) ! Valid since contiguous
+call rlv3(ptr(1,1,1)(1:2)) ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+call rlv3(assumed_sh_dummy(1,1,1)(1:2)) ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+call rlv3(pointer_dummy(1,1,1)(1:2)) ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+end
OSDN Git Service
