diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/fortran/interface.c | 25 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/argument_checking_13.f90 | 83 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/argument_checking_14.f90 | 68 |
5 files changed, 187 insertions, 3 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ad5d2c8..35944a2 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +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 diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 9057ef9..e0e3ff6 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -1520,7 +1520,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, && (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) { @@ -1546,7 +1546,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, 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 " @@ -1638,6 +1638,7 @@ get_expr_storage_size (gfc_expr *e) { int i; long int strlen, elements; + long int substrlen = 0; gfc_ref *ref; if (e == NULL) @@ -1672,6 +1673,16 @@ get_expr_storage_size (gfc_expr *e) 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) @@ -1729,13 +1740,21 @@ get_expr_storage_size (gfc_expr *e) 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; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d0c52a2..7a2d834 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +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 diff --git a/gcc/testsuite/gfortran.dg/argument_checking_13.f90 b/gcc/testsuite/gfortran.dg/argument_checking_13.f90 new file mode 100644 index 0000000..ae3fd22 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/argument_checking_13.f90 @@ -0,0 +1,83 @@ +! { 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 diff --git a/gcc/testsuite/gfortran.dg/argument_checking_14.f90 b/gcc/testsuite/gfortran.dg/argument_checking_14.f90 new file mode 100644 index 0000000..4c32b25 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/argument_checking_14.f90 @@ -0,0 +1,68 @@ +! { 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 |