]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
re PR fortran/30236 ([4.1 only]alternate-return subroutine in generic interface cause...
authorPaul Thomas <pault@gcc.gnu.org>
Tue, 19 Dec 2006 17:02:20 +0000 (17:02 +0000)
committerPaul Thomas <pault@gcc.gnu.org>
Tue, 19 Dec 2006 17:02:20 +0000 (17:02 +0000)
2006-12-19  Paul Thomas <pault@gcc.gnu.org>

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 <pault@gcc.gnu.org>

PR fortran/30236
* gfortran.dg/altreturn_3.f90: New test.

* gfortran.dg/char_result_12.f90: Fix comment typos.

From-SVN: r120052

gcc/fortran/ChangeLog
gcc/fortran/interface.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/altreturn_3.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/char_result_12.f90

index 7bf9577d73609bea9ba6b07aef1e7823edc05cc1..89c1252d40634de8f89f35e39905b791e9ecd2b4 100644 (file)
@@ -1,3 +1,13 @@
+2006-12-19  Paul Thomas <pault@gcc.gnu.org>
+
+       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  <roger@eyesopen.com>
 
        * trans-array.c (gfc_conv_array_index_offset): Avoid multiplying
index 28747e05be51d5d147a7255a35ba704f542ed510..611754ccbd9dab738f815c767aef43e58a33b98b 100644 (file)
@@ -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;
     }
 
index a5a2d1d83ac515e7dc2535fa24279da8a7271990..a901726bbf2a3cc969e9737d1557caa18fbed408 100644 (file)
@@ -1,3 +1,10 @@
+2006-12-19  Paul Thomas <pault@gcc.gnu.org>
+
+       PR fortran/30236
+       * gfortran.dg/altreturn_3.f90: New test.
+
+       * gfortran.dg/char_result_12.f90: Fix comment typos.
+
 2006-12-19  Ben Elliston  <bje@au.ibm.com>
 
        * 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 (file)
index 0000000..d4b5afb
--- /dev/null
@@ -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 <brooks@gcc.gnu.org>
+!
+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" } }
index b6ddfc089ac35457fe3d78ac42f209de04169a83..6612dcf888fa5e94351cbf7a2d9bc72152431816 100644 (file)
@@ -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  <pmason@ricardo.com>
+! Contributed by Philip Mason  <pmason@ricardo.com>
 !
  program testat
  character(len=4)   :: ctemp(2)