2010-02-10 Joost VandeVondele <jv244@cam.ac.uk>

            Tobias Burnus <burnus@net-b.de>

        PR fortran/40823
        * decl.c (gfc_match_subroutine): Explicitly set
        * sym->declared_at.

2010-02-10  Tobias Burnus <burnus@net-b.de>

        PR fortran/40823
        * gfortran.dg/private_type_1.f90: Update error location.
        * gfortran.dg/invalid_interface_assignment.f90: Ditto.
        * gfortran.dg/typebound_operator_2.f03: Ditto.
        * gfortran.dg/assignment_2.f90: Ditto.
        * gfortran.dg/redefined_intrinsic_assignment.f90: Ditto.
        * gfortran.dg/binding_label_tests_9.f03: Ditto.



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

9 files changed, 35 insertions, 15 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index fc9a6410159..5efa90cdcfa 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2010-02-10  Joost VandeVondele <jv244@cam.ac.uk>
+	    Tobias Burnus <burnus@net-b.de>
+
+	PR fortran/40823
+	* decl.c (gfc_match_subroutine): Explicitly set sym->declared_at.
+
 2010-02-10  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/43015
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 015d6a4ef94..82c67ae0045 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1,5 +1,5 @@
 /* Declaration statement matcher
-   Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009
+   Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009, 2010
    Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
@@ -5100,6 +5100,10 @@ gfc_match_subroutine (void)
   if (get_proc_name (name, &sym, false))
     return MATCH_ERROR;
 
+  /* Set declared_at as it might point to, e.g., a PUBLIC statement, if
+     the symbol existed before. */
+  sym->declared_at = gfc_current_locus;
+
   if (add_hidden_procptr_result (sym) == SUCCESS)
     sym = sym->result;
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index fdb07a6115e..b3b5d770da4 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,13 @@
+2010-02-10  Tobias Burnus <burnus@net-b.de>
+
+	PR fortran/40823
+	* gfortran.dg/private_type_1.f90: Update error location.
+	* gfortran.dg/invalid_interface_assignment.f90: Ditto.
+	* gfortran.dg/typebound_operator_2.f03: Ditto.
+	* gfortran.dg/assignment_2.f90: Ditto.
+	* gfortran.dg/redefined_intrinsic_assignment.f90: Ditto.
+	* gfortran.dg/binding_label_tests_9.f03: Ditto.
+
 2010-02-10  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/43015
diff --git a/gcc/testsuite/gfortran.dg/assignment_2.f90 b/gcc/testsuite/gfortran.dg/assignment_2.f90
index 3549fbea983..47e400962cb 100644
--- a/gcc/testsuite/gfortran.dg/assignment_2.f90
+++ b/gcc/testsuite/gfortran.dg/assignment_2.f90
@@ -38,10 +38,10 @@ end module m2
 
 MODULE m3
           INTERFACE ASSIGNMENT(=)
-             module procedure s ! { dg-error "must not redefine an INTRINSIC type" }
+             module procedure s
           END Interface
 contains
-             SUBROUTINE s(a,b)
+             SUBROUTINE s(a,b) ! { dg-error "must not redefine an INTRINSIC type" }
                  REAL,INTENT(OUT),VOLATILE :: a(1,*)
                  REAL,INTENT(IN) :: b(:,:)
              END SUBROUTINE
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_9.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_9.f03
index 0f50a08b7e0..cdf1ef880df 100644
--- a/gcc/testsuite/gfortran.dg/binding_label_tests_9.f03
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_9.f03
@@ -2,18 +2,18 @@
 module x
   use iso_c_binding
   implicit none
-  private :: bar ! { dg-warning "PRIVATE but has been given the binding label" }
+  private :: bar
   private :: my_private_sub
-  private :: my_private_sub_2 ! { dg-warning "PRIVATE but has been given the binding label" }
+  private :: my_private_sub_2
   public :: my_public_sub
 contains
-  subroutine bar() bind(c,name="foo") 
+  subroutine bar() bind(c,name="foo") ! { dg-warning "PRIVATE but has been given the binding label" }
   end subroutine bar
   
   subroutine my_private_sub() bind(c, name="")
   end subroutine my_private_sub
 
-  subroutine my_private_sub_2() bind(c) 
+  subroutine my_private_sub_2() bind(c) ! { dg-warning "PRIVATE but has been given the binding label" }
   end subroutine my_private_sub_2
 
   subroutine my_public_sub() bind(c, name="my_sub")
diff --git a/gcc/testsuite/gfortran.dg/invalid_interface_assignment.f90 b/gcc/testsuite/gfortran.dg/invalid_interface_assignment.f90
index d29163d8de6..f3c6e1269b2 100644
--- a/gcc/testsuite/gfortran.dg/invalid_interface_assignment.f90
+++ b/gcc/testsuite/gfortran.dg/invalid_interface_assignment.f90
@@ -9,10 +9,10 @@ MODULE TT
    INTEGER :: I
  END TYPE data_type
  INTERFACE ASSIGNMENT (=)
-   MODULE PROCEDURE set   ! { dg-error "Alternate return cannot appear" }
+   MODULE PROCEDURE set
  END INTERFACE
 CONTAINS
-  PURE SUBROUTINE set(x1,*)
+  PURE SUBROUTINE set(x1,*) ! { dg-error "Alternate return cannot appear" }
     TYPE(data_type), INTENT(OUT) :: x1
     x1%i=0
   END SUBROUTINE set
diff --git a/gcc/testsuite/gfortran.dg/private_type_1.f90 b/gcc/testsuite/gfortran.dg/private_type_1.f90
index b6e915104b9..96b2eb4c8be 100644
--- a/gcc/testsuite/gfortran.dg/private_type_1.f90
+++ b/gcc/testsuite/gfortran.dg/private_type_1.f90
@@ -6,12 +6,12 @@
 module modboom
   implicit none
   private
-  public:: dummysub ! { dg-error "PRIVATE type and cannot be a dummy argument" }
+  public:: dummysub
   type:: intwrapper
     integer n
   end type intwrapper
 contains
-  subroutine dummysub(size, arg_array)
+  subroutine dummysub(size, arg_array) ! { dg-error "PRIVATE type and cannot be a dummy argument" }
    type(intwrapper) :: size
    real, dimension(size%n) :: arg_array
    real :: local_array(4)
diff --git a/gcc/testsuite/gfortran.dg/redefined_intrinsic_assignment.f90 b/gcc/testsuite/gfortran.dg/redefined_intrinsic_assignment.f90
index 915f92e3982..40a0910b1ed 100644
--- a/gcc/testsuite/gfortran.dg/redefined_intrinsic_assignment.f90
+++ b/gcc/testsuite/gfortran.dg/redefined_intrinsic_assignment.f90
@@ -7,10 +7,10 @@
 MODULE M1
  IMPLICIT NONE
  INTERFACE ASSIGNMENT(=)
-  MODULE PROCEDURE T1 ! { dg-error "redefine an INTRINSIC type assignment" }
+  MODULE PROCEDURE T1
  END INTERFACE
 CONTAINS
- SUBROUTINE T1(I,J)
+ SUBROUTINE T1(I,J) ! { dg-error "redefine an INTRINSIC type assignment" }
    INTEGER, INTENT(OUT)  :: I
    INTEGER, INTENT(IN)  :: J
    I=-J
diff --git a/gcc/testsuite/gfortran.dg/typebound_operator_2.f03 b/gcc/testsuite/gfortran.dg/typebound_operator_2.f03
index b8dc5c9d104..cae2cdab71f 100644
--- a/gcc/testsuite/gfortran.dg/typebound_operator_2.f03
+++ b/gcc/testsuite/gfortran.dg/typebound_operator_2.f03
@@ -14,7 +14,7 @@ MODULE m
     PROCEDURE, NOPASS :: nopassed => onearg
     PROCEDURE, PASS :: threearg
     PROCEDURE, PASS :: sub
-    PROCEDURE, PASS :: sub2 ! { dg-error "must be a FUNCTION" }
+    PROCEDURE, PASS :: sub2
     PROCEDURE, PASS :: func
 
     ! These give errors at the targets' definitions.
@@ -57,7 +57,7 @@ CONTAINS
     CLASS(t), INTENT(IN) :: a
   END SUBROUTINE sub
 
-  SUBROUTINE sub2 (a, x)
+  SUBROUTINE sub2 (a, x) ! { dg-error "must be a FUNCTION" }
     CLASS(t), INTENT(IN) :: a
     INTEGER, INTENT(IN) :: x
   END SUBROUTINE sub2