From: Paul Thomas Date: Tue, 19 Dec 2006 17:02:20 +0000 (+0000) Subject: re PR fortran/30236 ([4.1 only]alternate-return subroutine in generic interface cause... X-Git-Tag: releases/gcc-4.3.0~7906 X-Git-Url: http://git.ipfire.org/gitweb.cgi?a=commitdiff_plain;h=26f2ca2b6f05e0fac53cee2cfe6ab99839fd0cb9;p=thirdparty%2Fgcc.git re PR fortran/30236 ([4.1 only]alternate-return subroutine in generic interface causes ice/segfault) 2006-12-19 Paul Thomas PR fortran/30236 * interface.c (compare_interfaces): Handle NULL symbols. (count_types_test): Count NULL symbols, which correspond to alternate returns. (check_interface1): Change final argument from int to bool in the function and all references. 2006-12-19 Paul Thomas PR fortran/30236 * gfortran.dg/altreturn_3.f90: New test. * gfortran.dg/char_result_12.f90: Fix comment typos. From-SVN: r120052 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7bf9577d7360..89c1252d4063 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2006-12-19 Paul Thomas + + PR fortran/30236 + * interface.c (compare_interfaces): Handle NULL symbols. + (count_types_test): Count NULL symbols, which correspond to + alternate returns. + + (check_interface1): Change final argument from int to bool + in the function and all references. + 2006-12-18 Roger Sayle * trans-array.c (gfc_conv_array_index_offset): Avoid multiplying diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 28747e05be51..611754ccbd9d 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -443,6 +443,8 @@ static int compare_interfaces (gfc_symbol *, gfc_symbol *, int); static int compare_type_rank_if (gfc_symbol * s1, gfc_symbol * s2) { + if (s1 == NULL || s2 == NULL) + return s1 == s2 ? 1 : 0; if (s1->attr.flavor != FL_PROCEDURE && s2->attr.flavor != FL_PROCEDURE) return compare_type_rank (s1, s2); @@ -731,14 +733,14 @@ count_types_test (gfc_formal_arglist * f1, gfc_formal_arglist * f2) if (arg[i].flag != -1) continue; - if (arg[i].sym->attr.optional) + if (arg[i].sym && arg[i].sym->attr.optional) continue; /* Skip optional arguments */ arg[i].flag = k; /* Find other nonoptional arguments of the same type/rank. */ for (j = i + 1; j < n1; j++) - if (!arg[j].sym->attr.optional + if ((arg[j].sym == NULL || !arg[j].sym->attr.optional) && compare_type_rank_if (arg[i].sym, arg[j].sym)) arg[j].flag = k; @@ -968,7 +970,7 @@ check_interface0 (gfc_interface * p, const char *interface_name) static int check_interface1 (gfc_interface * p, gfc_interface * q0, int generic_flag, const char *interface_name, - int referenced) + bool referenced) { gfc_interface * q; for (; p; p = p->next) @@ -1008,7 +1010,7 @@ static void check_sym_interfaces (gfc_symbol * sym) { char interface_name[100]; - int k; + bool k; if (sym->ns != gfc_current_ns) return; @@ -1048,7 +1050,7 @@ check_uop_interfaces (gfc_user_op * uop) continue; check_interface1 (uop->operator, uop2->operator, 0, - interface_name, 1); + interface_name, true); } } @@ -1090,7 +1092,7 @@ gfc_check_interfaces (gfc_namespace * ns) for (ns2 = ns->parent; ns2; ns2 = ns2->parent) if (check_interface1 (ns->operator[i], ns2->operator[i], 0, - interface_name, 1)) + interface_name, true)) break; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index a5a2d1d83ac5..a901726bbf2a 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2006-12-19 Paul Thomas + + PR fortran/30236 + * gfortran.dg/altreturn_3.f90: New test. + + * gfortran.dg/char_result_12.f90: Fix comment typos. + 2006-12-19 Ben Elliston * gcc.dg/cpp/trad/include.c: #include stdlib.h instead of stdio.h, diff --git a/gcc/testsuite/gfortran.dg/altreturn_3.f90 b/gcc/testsuite/gfortran.dg/altreturn_3.f90 new file mode 100644 index 000000000000..d4b5afb9ce8d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/altreturn_3.f90 @@ -0,0 +1,43 @@ +! { dg-do run} +! Tests the fix for PR30236, which was due to alternate returns +! in generic interfaces causing a segfault. They now work +! correctly. +! +! Contributed by Brooks Moses +! +module arswitch + implicit none + interface gen + module procedure with + module procedure without + end interface +contains + subroutine with(i,*) + integer i + if (i>0) then + i = -1 + return 1 + else + i = -2 + return + end if + end subroutine + subroutine without() + return + end subroutine +end module + +program test + use arswitch + implicit none + integer :: i = 0 + call gen (i, *10) + if (i /= -2) call abort () + i = 2 + call gen (i, *20) + 10 continue + call abort() + 20 continue + if (i /= -1) call abort () +end +! { dg-final { cleanup-modules "arswitch" } } diff --git a/gcc/testsuite/gfortran.dg/char_result_12.f90 b/gcc/testsuite/gfortran.dg/char_result_12.f90 index b6ddfc089ac3..6612dcf888fa 100644 --- a/gcc/testsuite/gfortran.dg/char_result_12.f90 +++ b/gcc/testsuite/gfortran.dg/char_result_12.f90 @@ -1,8 +1,8 @@ ! { dg-do run } ! Tests the fix for PR29912, in which the call to JETTER -! would cause a segfault beause a temporary was not being written. +! would cause a segfault because a temporary was not being written. ! -! COntributed by Philip Mason +! Contributed by Philip Mason ! program testat character(len=4) :: ctemp(2)