mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-01-26 00:54:45 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/30865 ([4.1, 4.2 only] optional argument passed on to size(...,dim=))

Browse Source 
2007-02-26  Thomas Koenig  <Thomas.Koenig@online.de>
	    Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/30865
	* trans-intrinsic.c (gfc_conv_intrinsic_size):
	If dim is an optional argument, check for its
	presence and call size0 or size1, respectively.

2007-02-26  Thomas Koenig  <Thomas.Koenig@online.de>

	PR fortran/30865
	* size_optional_dim_1.f90:  New test.


Co-Authored-By: Paul Thomas <pault@gcc.gnu.org>

From-SVN: r122342
This commit is contained in:
Thomas Koenig 2007-02-26 21:16:00 +00:00 committed by Thomas Koenig
parent 57a4c089e2
commit 88f206a40d
4 changed files with 67 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/fortran/ChangeLog
View File

@ -1,3 +1,11 @@
2007-02-26 Thomas Koenig <Thomas.Koenig@online.de>
Paul Thomas <pault@gcc.gnu.org>
PR fortran/30865
* trans-intrinsic.c (gfc_conv_intrinsic_size):
If dim is an optional argument, check for its
presence and call size0 or size1, respectively.
2007-02-23 Paul Thomas <pault@gcc.gnu.org>
PR fortran/30660

41
gcc/fortran/trans-intrinsic.c
View File

@ -2681,9 +2681,10 @@ static void
gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr)
{
gfc_actual_arglist *actual;
tree args;
tree arg1;
tree type;
tree fndecl;
tree fncall0;
tree fncall1;
gfc_se argse;
gfc_ss *ss;
@ -2697,21 +2698,45 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr)
gfc_conv_expr_descriptor (&argse, actual->expr, ss);
gfc_add_block_to_block (&se->pre, &argse.pre);
gfc_add_block_to_block (&se->post, &argse.post);
args = gfc_chainon_list (NULL_TREE, argse.expr);
arg1 = gfc_evaluate_now (argse.expr, &se->pre);
/* Build the call to size0. */
fncall0 = build_call_expr (gfor_fndecl_size0, 1, arg1);
actual = actual->next;
if (actual->expr)
{
gfc_init_se (&argse, NULL);
gfc_conv_expr_type (&argse, actual->expr, gfc_array_index_type);
gfc_conv_expr_type (&argse, actual->expr,
gfc_array_index_type);
gfc_add_block_to_block (&se->pre, &argse.pre);
args = gfc_chainon_list (args, argse.expr);
fndecl = gfor_fndecl_size1;
/* Build the call to size1. */
fncall1 = build_call_expr (gfor_fndecl_size1, 2,
arg1, argse.expr);
/* Unusually, for an intrinsic, size does not exclude
an optional arg2, so we must test for it. */
if (actual->expr->expr_type == EXPR_VARIABLE
&& actual->expr->symtree->n.sym->attr.dummy
&& actual->expr->symtree->n.sym->attr.optional)
{
tree tmp;
tmp = gfc_build_addr_expr (pvoid_type_node,
argse.expr);
tmp = build2 (NE_EXPR, boolean_type_node, tmp,
build_int_cst (pvoid_type_node, 0));
tmp = gfc_evaluate_now (tmp, &se->pre);
se->expr = build3 (COND_EXPR, pvoid_type_node,
tmp, fncall1, fncall0);
}
else
se->expr = fncall1;
}
else
fndecl = gfor_fndecl_size0;
se->expr = fncall0;
se->expr = build_function_call_expr (fndecl, args);
type = gfc_typenode_for_spec (&expr->ts);
se->expr = convert (type, se->expr);
}

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2007-02-26 Thomas Koenig <Thomas.Koenig@online.de>
PR fortran/30865
* size_optional_dim_1.f90: New test.
2007-02-25 Mark Mitchell <mark@codesourcery.com>
* gcc.dg/vxworks/vxworks.exp: New file.

21
gcc/testsuite/gfortran.dg/size_optional_dim_1.f90 Normal file
View File

@ -0,0 +1,21 @@
! { dg-do run }
! PR 30865 - passing a subroutine optional argument to size(dim=...)
! used to segfault.
program main
implicit none
integer :: a(2,3)
integer :: ires
call checkv (ires, a)
if (ires /= 6) call abort
call checkv (ires, a, 1)
if (ires /= 2) call abort
contains
subroutine checkv(ires,a1,opt1)
integer, intent(out) :: ires
integer :: a1(:,:)
integer, optional :: opt1
ires = size (a1, dim=opt1)
end subroutine checkv
end program main