re PR fortran/41615 (Bogus error message: "internal function" should be "module proce...

2009-10-07  Daniel Kraft  <d@domob.eu>

	PR fortran/41615
	* resolve.c (resolve_contained_fntype): Clarify error message for
	invalid assumed-length character result on module procedures.

2009-10-07  Daniel Kraft  <d@domob.eu>

	PR fortran/41615
	* gfortran.dg/assumed_charlen_function_6.f90: New test.

From-SVN: r152534

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7b4ecc60a1ebe7a77992669a663fe0f6446322f5..5035c1b7d57535464397cce3d372db06a3e1e345 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2009-10-07  Daniel Kraft  <d@domob.eu>
+
+       PR fortran/41615
+       * resolve.c (resolve_contained_fntype): Clarify error message for
+       invalid assumed-length character result on module procedures.
+
 2009-10-07  Janus Weil  <janus@gcc.gnu.org>
 
        * expr.c (gfc_check_pointer_assign): Do the correct type checking when

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 4092891f2c95fda10d91d63d8ade076416865ffa..1aee540969c91d37380e9d523a7977696843e576 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -367,15 +367,26 @@ resolve_contained_fntype (gfc_symbol *sym, gfc_namespace *ns)
   /* Fortran 95 Draft Standard, page 51, Section 5.1.1.5, on the Character 
      type, lists the only ways a character length value of * can be used:
      dummy arguments of procedures, named constants, and function results
-     in external functions.  Internal function results are not on that list;
-     ergo, not permitted.  */
+     in external functions.  Internal function results and results of module
+     procedures are not on this list, ergo, not permitted.  */
 
   if (sym->result->ts.type == BT_CHARACTER)
     {
       gfc_charlen *cl = sym->result->ts.u.cl;
       if (!cl || !cl->length)
-       gfc_error ("Character-valued internal function '%s' at %L must "
-                  "not be assumed length", sym->name, &sym->declared_at);
+       {
+         /* See if this is a module-procedure and adapt error message
+            accordingly.  */
+         bool module_proc;
+         gcc_assert (ns->parent && ns->parent->proc_name);
+         module_proc = (ns->parent->proc_name->attr.flavor == FL_MODULE);
+
+         gfc_error ("Character-valued %s '%s' at %L must not be"
+                    " assumed length",
+                    module_proc ? _("module procedure")
+                                : _("internal function"),
+                    sym->name, &sym->declared_at);
+       }
     }
 }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index f67f6716f1275e57e93c6ea5c50cb08554a9cdd2..41a7a5e5969febe55cf76257e41a65d0e709794f 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2009-10-07  Daniel Kraft  <d@domob.eu>
+
+       PR fortran/41615
+       * gfortran.dg/assumed_charlen_function_6.f90: New test.
+
 2009-10-07  Janus Weil  <janus@gcc.gnu.org>
 
        * gfortran.dg/same_type_as_2.f03: Modified (was illegal).

diff --git a/gcc/testsuite/gfortran.dg/assumed_charlen_function_6.f90 b/gcc/testsuite/gfortran.dg/assumed_charlen_function_6.f90
new file mode 100644 (file)
index 0000000..49d1a2e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_charlen_function_6.f90
@@ -0,0 +1,37 @@
+! { dg-do compile }
+
+! PR fortran/41615
+! Output nicer error message for invalid assumed-len character function result
+! depending on what kind of contained procedure it is.
+
+module funcs
+   implicit none
+contains
+      function assumed_len(x) ! { dg-error "module procedure" }
+         character(*) assumed_len
+         integer, intent(in) :: x
+      end function assumed_len
+end module funcs
+
+module mod2
+  implicit none
+contains
+  subroutine mysub ()
+    contains
+      function assumed_len(x) ! { dg-error "internal function" }
+         character(*) assumed_len
+         integer, intent(in) :: x
+      end function assumed_len
+  end subroutine
+end module mod2
+
+program main
+  implicit none
+contains
+      function assumed_len(x) ! { dg-error "internal function" }
+         character(*) assumed_len
+         integer, intent(in) :: x
+      end function assumed_len
+end program main
+
+! { dg-final { cleanup-modules "funcs mod2" } }