git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

interface.c (compare_actual_formal): Issue error when attempting to pass an assumed-size array as assumed-shape... 

* interface.c (compare_actual_formal): Issue error when attempting
	to pass an assumed-size array as assumed-shape array argument.

	* gfortran.dg/assumed_dummy_2.f90: New test.

From-SVN: r105765
This commit is contained in:
Jakub Jelinek 2005-10-21 20:50:52 +02:00 committed by Jakub Jelinek
parent 2c47f8751a
commit bf9d2177bf
4 changed files with 39 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/fortran/ChangeLog
View File

@ -1,3 +1,8 @@
2005-10-21 Jakub Jelinek <jakub@redhat.com>
* interface.c (compare_actual_formal): Issue error when attempting
to pass an assumed-size array as assumed-shape array argument.
2005-10-20 Erik Edelmann <erik.edelmann@iki.fi>
PR fortran/21625

15
gcc/fortran/interface.c
View File

@ -1235,6 +1235,21 @@ compare_actual_formal (gfc_actual_arglist ** ap,
return 0;
}
if (f->sym->as
&& f->sym->as->type == AS_ASSUMED_SHAPE
&& a->expr->expr_type == EXPR_VARIABLE
&& a->expr->symtree->n.sym->as
&& a->expr->symtree->n.sym->as->type == AS_ASSUMED_SIZE
&& (a->expr->ref == NULL
|| (a->expr->ref->type == REF_ARRAY
&& a->expr->ref->u.ar.type == AR_FULL)))
{
if (where)
gfc_error ("Actual argument for '%s' cannot be an assumed-size"
" array at %L", f->sym->name, where);
return 0;
}
if (a->expr->expr_type != EXPR_NULL
&& compare_pointer (f->sym, a->expr) == 0)
{

4
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,7 @@
2005-10-21 Jakub Jelinek <jakub@redhat.com>
* gfortran.dg/assumed_dummy_2.f90: New test.
2005-10-21 James E Wilson <wilson@specifix.com>
PR preprocessor/15220

15
gcc/testsuite/gfortran.dg/assumed_dummy_2.f90 Normal file
View File

@ -0,0 +1,15 @@
! { dg-do compile }
double precision :: arr(5, 8)
call bar (arr)
contains
subroutine foo (arr)
double precision :: arr(:,:)
arr(3, 4) = 24
end subroutine foo
subroutine bar (arr)
double precision :: arr(5,*)
call foo (arr) ! { dg-error "cannot be an assumed-size array" }
call foo (arr (:, :8))
end subroutine
end