re PR fortran/34760 (PRIVATE variable not allowed as STAT variable in ALLOCATE)

2008-01-19  Tobias Burnus  <burnus@net-b.de>

        PR fortran/34760
        * primary.c (match_variable): Handle FL_UNKNOWN without
        uneducated guessing.
        (match_variable): Improve error message.

2008-01-19  Tobias Burnus  <burnus@net-b.de>

        PR fortran/34760
        * gfortran.dg/implicit_11.f90: New.
        * gfortran.dg/allocate_stat.f90: Update dg-error pattern.
        * gfortran.dg/entry_15.f90: Ditto.
        * gfortran.dg/func_assign.f90: Ditto.
        * gfortran.dg/gomp/reduction3.f90: Ditto.
        * gfortran.dg/proc_assign_1.f90: Ditto.

        * gfortran.dg/interface_proc_end.f90: Use dg-error instead
        of dg-excess-errors.

From-SVN: r131652

10 files changed, 84 insertions, 16 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 736c67f..46c95e0 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2008-01-19  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34760
+	* primary.c (match_variable): Handle FL_UNKNOWN without
+	uneducated guessing.
+	(match_variable): Improve error message.
+
 2008-01-18  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/32616
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 1d282f2..4e7d4a1 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -2521,12 +2521,22 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag)
       break;
 
     case FL_UNKNOWN:
-      if (sym->attr.access == ACCESS_PUBLIC
-	  || sym->attr.access == ACCESS_PRIVATE)
-	break;
-      if (gfc_add_flavor (&sym->attr, FL_VARIABLE,
-			  sym->name, NULL) == FAILURE)
-	return MATCH_ERROR;
+      {
+	sym_flavor flavor = FL_UNKNOWN;
+
+	gfc_gobble_whitespace ();
+
+	if (sym->attr.external || sym->attr.procedure
+	    || sym->attr.function || sym->attr.subroutine)
+	  flavor = FL_PROCEDURE;
+	else if (gfc_peek_char () != '(' || sym->ts.type != BT_UNKNOWN
+		 || sym->attr.pointer || sym->as != NULL)
+	  flavor = FL_VARIABLE;
+
+	if (flavor != FL_UNKNOWN
+	    && gfc_add_flavor (&sym->attr, flavor, sym->name, NULL) == FAILURE)
+	  return MATCH_ERROR;
+      }
       break;
 
     case FL_PARAMETER:
@@ -2553,7 +2563,7 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag)
       /* Fall through to error */
 
     default:
-      gfc_error ("Expected VARIABLE at %C");
+      gfc_error ("'%s' at %C is not a variable", sym->name);
       return MATCH_ERROR;
     }
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index b25f7f5..73c1e60 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,16 @@
+2008-01-19  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34760
+	* gfortran.dg/implicit_11.f90: New.
+	* gfortran.dg/allocate_stat.f90: Update dg-error pattern.
+	* gfortran.dg/entry_15.f90: Ditto.
+	* gfortran.dg/func_assign.f90: Ditto.
+	* gfortran.dg/gomp/reduction3.f90: Ditto.
+	* gfortran.dg/proc_assign_1.f90: Ditto.
+
+	* gfortran.dg/interface_proc_end.f90: Use dg-error instead
+	of dg-excess-errors.
+
 2008-01-18  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/32616
diff --git a/gcc/testsuite/gfortran.dg/allocate_stat.f90 b/gcc/testsuite/gfortran.dg/allocate_stat.f90
index 1361d77..94ec430 100644
--- a/gcc/testsuite/gfortran.dg/allocate_stat.f90
+++ b/gcc/testsuite/gfortran.dg/allocate_stat.f90
@@ -38,7 +38,7 @@ function func2() result(res)
   implicit none
   real, pointer :: gain 
   integer :: res
-  allocate (gain,STAT=func2) ! { dg-error "Expected VARIABLE" }
+  allocate (gain,STAT=func2) ! { dg-error "is not a variable" }
   deallocate(gain)
   res = 0
 end function func2
diff --git a/gcc/testsuite/gfortran.dg/entry_15.f90 b/gcc/testsuite/gfortran.dg/entry_15.f90
index ed0eb4b..0449695 100644
--- a/gcc/testsuite/gfortran.dg/entry_15.f90
+++ b/gcc/testsuite/gfortran.dg/entry_15.f90
@@ -16,7 +16,7 @@ function func(a)
   func = a*8
   return
 entry ent(a) result(func2)
-  ent = -a*4.0 ! { dg-error "Expected VARIABLE" }
+  ent = -a*4.0 ! { dg-error "is not a variable" }
   return
 end function func
 end module m2
@@ -31,7 +31,7 @@ function func(a) result(res)
   res = a*12
   return
 entry ent(a) result(func2)
-  ent = -a*6.0 ! { dg-error "Expected VARIABLE" }
+  ent = -a*6.0 ! { dg-error "is not a variable" }
   return
 end function func
 end module m3
diff --git a/gcc/testsuite/gfortran.dg/func_assign.f90 b/gcc/testsuite/gfortran.dg/func_assign.f90
index 3651dfd..1f7407c 100644
--- a/gcc/testsuite/gfortran.dg/func_assign.f90
+++ b/gcc/testsuite/gfortran.dg/func_assign.f90
@@ -23,8 +23,8 @@ contains
      subroutine sub()
      end subroutine sub
    end interface
-   sub = 'a'  ! { dg-error "Expected VARIABLE" }
-   fun = 4.4  ! { dg-error "Expected VARIABLE" }
+   sub = 'a'  ! { dg-error "is not a variable" }
+   fun = 4.4  ! { dg-error "is not a variable" }
    funget = 4 ! { dg-error "is not a VALUE" }
    bar = 5    ! { dg-error "is not a VALUE" }
   end subroutine a
diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction3.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction3.f90
index 50f6450..abd6d04 100644
--- a/gcc/testsuite/gfortran.dg/gomp/reduction3.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/reduction3.f90
@@ -48,7 +48,7 @@ subroutine f4
   integer :: i, ior
   i = 6
 !$omp parallel reduction (ior:i)
-  ior = 4			 ! { dg-error "Expected VARIABLE" }
+  ior = 4			 ! { dg-error "is not a variable" }
 !$omp end parallel
 end subroutine f4
 subroutine f5
diff --git a/gcc/testsuite/gfortran.dg/implicit_11.f90 b/gcc/testsuite/gfortran.dg/implicit_11.f90
new file mode 100644
index 0000000..26cf5ae
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/implicit_11.f90
@@ -0,0 +1,38 @@
+! { dg-do compile }
+! 
+! PR fortran/34760
+! The problem with implict typing is that it is unclear
+! whether an existing symbol is a variable or a function.
+! Thus it remains long FL_UNKNOWN, which causes extra 
+! problems; it was failing here since ISTAT was not
+! FL_VARIABLE but still FL_UNKNOWN.
+!
+! Test case contributed by Dick Hendrickson.
+!
+     MODULE TESTS
+       PRIVATE :: ISTAT
+       PUBLIC :: ISTAT2
+     CONTAINS
+     SUBROUTINE AD0001
+     REAL RLA1(:)
+     ALLOCATABLE RLA1
+     ISTAT = -314
+     ALLOCATE (RLA1(NF10), STAT = ISTAT)
+     ALLOCATE (RLA1(NF10), STAT = ISTAT2)
+     END SUBROUTINE
+     END MODULE
+
+     MODULE TESTS2
+       PRIVATE :: ISTAT2
+     CONTAINS
+     function istat2()
+       istat2 = 0
+     end function istat2
+     SUBROUTINE AD0001
+       REAL RLA1(:)
+       ALLOCATABLE RLA1
+       ALLOCATE (RLA1(NF10), STAT = ISTAT2) ! { dg-error "must be a variable" }
+     END SUBROUTINE
+     END MODULE tests2
+
+! { dg-final { cleanup-modules "TESTS" } }
diff --git a/gcc/testsuite/gfortran.dg/interface_proc_end.f90 b/gcc/testsuite/gfortran.dg/interface_proc_end.f90
index d037de6..c6ea2b9 100644
--- a/gcc/testsuite/gfortran.dg/interface_proc_end.f90
+++ b/gcc/testsuite/gfortran.dg/interface_proc_end.f90
@@ -16,4 +16,4 @@
       END INTERFACE
       end ! { dg-error "END SUBROUTINE statement" }
       end module ! { dg-error "END SUBROUTINE statement" }
-! { dg-excess-errors "Unexpected end of file" }
+! { dg-error "Unexpected end of file" "" { target "*-*-*" } 0 }
diff --git a/gcc/testsuite/gfortran.dg/proc_assign_1.f90 b/gcc/testsuite/gfortran.dg/proc_assign_1.f90
index 418e5f4..9f2952b 100644
--- a/gcc/testsuite/gfortran.dg/proc_assign_1.f90
+++ b/gcc/testsuite/gfortran.dg/proc_assign_1.f90
@@ -58,12 +58,12 @@ end module simpler
     end interface

     stmt_fcn (w) = sin (w)     

     call x (y ())

-    x = 10                   ! { dg-error "Expected VARIABLE" }

+    x = 10                   ! { dg-error "is not a variable" }

     y = 20                   ! { dg-error "is not a VALUE" }

     foo_er = 8               ! { dg-error "is not a VALUE" }

     ext1 = 99                ! { dg-error "is not a VALUE" }

     ext2 = 99                ! { dg-error "is not a VALUE" }

-    stmt_fcn = 1.0           ! { dg-error "Expected VARIABLE" }

+    stmt_fcn = 1.0           ! { dg-error "is not a variable" }

     w = stmt_fcn (1.0)

 contains

     subroutine x (i)