fortran/
authorbrooks <brooks@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 4 Jan 2007 17:30:37 +0000 (17:30 +0000)
committerbrooks <brooks@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 4 Jan 2007 17:30:37 +0000 (17:30 +0000)
PR 30235
* interface.c (compare_actual_formal): check for
alternate returns when iterating over non-present
arguments.

testsuite/
PR 30235
* gfortran.dg/altreturn_2.f90: new test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@120447 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/interface.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/altreturn_2.f90 [new file with mode: 0755]

index ced91a8..2333b82 100644 (file)
@@ -1,5 +1,12 @@
 2007-01-04  Brooks Moses  <brooks.moses@codesourcery.com>
 
+       PR 30235
+       * interface.c (compare_actual_formal): check for
+       alternate returns when iterating over non-present
+       arguments.
+
+2007-01-04  Brooks Moses  <brooks.moses@codesourcery.com>
+
        * invoke.texi: Update manpage copyright to include 2007.
 
 2007-01-04  Brooks Moses  <brooks.moses@codesourcery.com>
index dd1ac69..7b0c423 100644 (file)
@@ -1455,6 +1455,13 @@ compare_actual_formal (gfc_actual_arglist ** ap,
     {
       if (new[i] != NULL)
        continue;
+      if (f->sym == NULL)
+       {
+         if (where)
+           gfc_error ("Missing alternate return spec in subroutine call at %L",
+                      where);
+         return 0;
+       }
       if (!f->sym->attr.optional)
        {
          if (where)
index 0663f79..0309fad 100644 (file)
@@ -1,3 +1,8 @@
+2006-01-04  Brooks Moses  <brooks.moses@codesourcery.com>
+
+       PR 30235
+       * gfortran.dg/altreturn_2.f90: new test.
+
 2007-01-04  Tom Tromey  <tromey@redhat.com>
 
        PR preprocessor/28165:
diff --git a/gcc/testsuite/gfortran.dg/altreturn_2.f90 b/gcc/testsuite/gfortran.dg/altreturn_2.f90
new file mode 100755 (executable)
index 0000000..d0556d0
--- /dev/null
@@ -0,0 +1,8 @@
+! { dg-do compile }
+       program altreturn_2
+         call foo()  ! { dg-error "Missing alternate return" }
+       contains
+         subroutine foo(*)
+           return
+         end subroutine
+       end program