From 276ca25d7b89e90c6fda272f1aabc9da01d7342d Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Thu, 5 Apr 2007 14:06:15 +0000 Subject: re PR fortran/31483 ([4.1/4.2 only] ICE on fortran Code) 2007-04-05 Paul Thomas PR fortran/31483 * trans-expr.c (gfc_conv_function_call): Give a dummy procedure the correct type if it has alternate returns. 2007-04-05 Paul Thomas PR fortran/31483 * gfortran.dg/altreturn_5.f90: New test. From-SVN: r123518 --- gcc/fortran/ChangeLog | 6 ++++++ gcc/fortran/trans-expr.c | 18 ++++++++++++------ gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/altreturn_5.f90 | 31 +++++++++++++++++++++++++++++++ 4 files changed, 54 insertions(+), 6 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/altreturn_5.f90 (limited to 'gcc') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6e1be68..5b3001f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,11 @@ 2007-04-05 Paul Thomas + PR fortran/31483 + * trans-expr.c (gfc_conv_function_call): Give a dummy + procedure the correct type if it has alternate returns. + +2007-04-05 Paul Thomas + PR fortran/31292 * decl.c (gfc_match_modproc): Go up to the top of the namespace tree to find the module namespace for gfc_get_symbol. diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 036d55b..5ff0c44 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -2392,17 +2392,23 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym, /* Generate the actual call. */ gfc_conv_function_val (se, sym); + /* If there are alternate return labels, function type should be integer. Can't modify the type in place though, since it can be shared - with other functions. */ + with other functions. For dummy arguments, the typing is done to + to this result, even if it has to be repeated for each call. */ if (has_alternate_specifier && TREE_TYPE (TREE_TYPE (TREE_TYPE (se->expr))) != integer_type_node) { - gcc_assert (! sym->attr.dummy); - TREE_TYPE (sym->backend_decl) - = build_function_type (integer_type_node, - TYPE_ARG_TYPES (TREE_TYPE (sym->backend_decl))); - se->expr = build_fold_addr_expr (sym->backend_decl); + if (!sym->attr.dummy) + { + TREE_TYPE (sym->backend_decl) + = build_function_type (integer_type_node, + TYPE_ARG_TYPES (TREE_TYPE (sym->backend_decl))); + se->expr = build_fold_addr_expr (sym->backend_decl); + } + else + TREE_TYPE (TREE_TYPE (TREE_TYPE (se->expr))) = integer_type_node; } fntype = TREE_TYPE (TREE_TYPE (se->expr)); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c3fccfa..28316c2 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,10 @@ 2007-04-05 Paul Thomas + PR fortran/31483 + * gfortran.dg/altreturn_5.f90: New test. + +2007-04-05 Paul Thomas + PR fortran/31292 * gfortran.dg/contained_module_proc_1.f90: New test. diff --git a/gcc/testsuite/gfortran.dg/altreturn_5.f90 b/gcc/testsuite/gfortran.dg/altreturn_5.f90 new file mode 100644 index 0000000..ff1b822 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/altreturn_5.f90 @@ -0,0 +1,31 @@ +! { dg-do run } +! Tests the fix for PR31483, in which dummy argument procedures +! produced an ICE if they had an alternate return. +! +! Contributed by Mathias Fröhlich + + SUBROUTINE R (i, *, *) + INTEGER i + RETURN i + END + + SUBROUTINE PHLOAD (READER, i, res) + IMPLICIT NONE + EXTERNAL READER + integer i + character(3) res + CALL READER (i, *1, *2) + 1 res = "one" + return + 2 res = "two" + return + END + + EXTERNAL R + character(3) res + call PHLOAD (R, 1, res) + if (res .ne. "one") call abort () + CALL PHLOAD (R, 2, res) + if (res .ne. "two") call abort () + END + -- cgit v1.1