re PR fortran/31293 (Implicit character and array returning functions)

2007-04-07  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31293
	* symbol.c (gfc_check_function_type): New function.
	* gfortran.h : Add prototype for previous.
	* parse.c (parse_progunit): Call it after parsing specification
	statements.

2007-04-07  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31293
	* gfortran.dg/interface_12.f90: New test.

From-SVN: r123641

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5b3001f..e72aa0d 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2007-04-07  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/31293
+       * symbol.c (gfc_check_function_type): New function.
+       * gfortran.h : Add prototype for previous.
+       * parse.c (parse_progunit): Call it after parsing specification
+       statements.
+
 2007-04-05  Paul Thomas  <pault@gcc.gnu.org>\r
 \r
        PR fortran/31483\r

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 3ef4902..e9c71cd 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -483,7 +483,8 @@ typedef struct
   /* Variable attributes.  */
   unsigned allocatable:1, dimension:1, external:1, intrinsic:1,
     optional:1, pointer:1, save:1, target:1, value:1, volatile_:1,
-    dummy:1, result:1, assign:1, threadprivate:1, not_always_present:1;
+    dummy:1, result:1, assign:1, threadprivate:1, not_always_present:1,
+    implied_index:1;
 
   unsigned data:1,             /* Symbol is named in a DATA statement.  */
     protected:1,               /* Symbol has been marked as protected.  */
@@ -1853,6 +1854,7 @@ void gfc_clear_new_implicit (void);
 try gfc_add_new_implicit_range (int, int);
 try gfc_merge_new_implicit (gfc_typespec *);
 void gfc_set_implicit_none (void);
+void gfc_check_function_type (gfc_namespace *);
 
 gfc_typespec *gfc_get_default_type (gfc_symbol *, gfc_namespace *);
 try gfc_set_default_type (gfc_symbol *, int, gfc_namespace *);

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 2d17167..9e47ea4 100644 (file)
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -2915,6 +2915,9 @@ parse_progunit (gfc_statement st)
       break;
     }
 
+  if (gfc_current_state () == COMP_FUNCTION)
+    gfc_check_function_type (gfc_current_ns);
+
 loop:
   for (;;)
     {

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index b1c5ea3..ad99595 100644 (file)
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -253,6 +253,37 @@ gfc_set_default_type (gfc_symbol * sym, int error_flag, gfc_namespace * ns)
 }
 
 
+/* This function is called from parse.c(parse_progunit) to check the
+   type of the function is not implicitly typed in the host namespace
+   and to implicitly type the function result, if necessary.  */
+
+void
+gfc_check_function_type (gfc_namespace *ns)
+{
+  gfc_symbol *proc = ns->proc_name;
+
+  if (!proc->attr.contained || proc->result->attr.implicit_type)
+    return;
+
+  if (proc->result->ts.type == BT_UNKNOWN)
+    {
+      if (gfc_set_default_type (proc->result, 0, gfc_current_ns)
+               == SUCCESS)
+       {
+         if (proc->result != proc)
+           proc->ts = proc->result->ts;
+       }
+      else
+       {
+         gfc_error ("unable to implicitly type the function result "
+                    "'%s' at %L", proc->result->name,
+                    &proc->result->declared_at);
+         proc->result->attr.untyped = 1;
+       }
+    }
+}
+
+
 /******************** Symbol attribute stuff *********************/
 
 /* This is a generic conflict-checker.  We do this to avoid having a

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2d2bbc0..2f7fe10 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-04-07  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/31293
+       * gfortran.dg/interface_12.f90: New test.
+
 2007-04-07  Bruce Korb  <bkorb@gnu.org>
 
        * gcc.dg/format/opt-6.c: New test.

diff --git a/gcc/testsuite/gfortran.dg/interface_12.f90 b/gcc/testsuite/gfortran.dg/interface_12.f90
new file mode 100644 (file)
index 0000000..a45817d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_12.f90
@@ -0,0 +1,90 @@
+! { dg-do run }
+! Test the fix for PR31293.
+!
+! File: interface4.f90
+! http://home.comcast.net/%7Ekmbtib/Fortran_stuff/interface4.f90
+! Public domain 2004 James Van Buskirk
+! Second attempt to actually create function with LEN
+! given by specification expression via function name,
+! and SIZE given by specification expression via
+! result name.
+
+! g95 12/18/04: Error: Circular specification in variable 'r'.
+! ISO/IEC 1539-1:1997(E) section 512.5.2.2:
+! "If RESULT is specified, the name of the result variable
+! of the function is result-name, its characteristics
+! (12.2.2) are those of the function result, and..."
+! Also from the same section:
+! The type and type parameters (if any) of the result of the
+! function subprogram may be specified by a type specification
+! in the FUNCTION statement or by the name of the result variable
+! appearing in a type statement in the declaration part of the
+! function subprogram.  It shall not be specified both ways."
+! Also in section 7.1.6.2:
+! "A restricted expression is one in which each operation is
+! intrinsic and each primary is
+! ...
+! (7) A reference to an intrinsic function that is
+! ...
+!     (c) the character inquiry function LEN,
+! ...
+!     and where each primary of the function is
+! ...
+!     (b) a variable whose properties inquired about are not
+!         (i)   dependent on the upper bound of the last
+!               dimension of an assumed-shape array.
+!         (ii)  defined by an expression that is not a
+!               restricted expression
+!         (iii) definable by an ALLOCATE or pointer
+!               assignment statement."
+! So I think there is no problem with the specification of
+! the function result attributes; g95 flunks.
+
+! CVF 6.6C3: Error: This name does not have a type, and must
+! have an explicit type. [R]
+! Clearly R has a type here: the type and type parameters of
+! the function result; CVF flunks.
+
+! LF95 5.70f: Type parameters or bounds of variable r may
+! not be inquired.
+! Again, the type parameters, though not the bounds, of
+! variable r may in fact be inquired; LF95 flunks.
+
+module test1
+   implicit none
+   contains
+      character(f (x)) function test2 (x) result(r)
+         implicit integer (x)
+         dimension r(modulo (len (r) - 1, 3) + 1)
+         integer, intent(in) :: x
+         interface
+            pure function f (x)
+               integer, intent(in) :: x
+               integer f
+            end function f
+         end interface
+         integer i
+
+         do i = 1, len (r)
+            r(:)(i:i) = achar (mod (i, 32) + iachar ('@'))
+         end do
+      end function test2
+end module test1
+
+program test
+   use test1
+   implicit none
+   character(21) :: chr (3)
+   chr = "ABCDEFGHIJKLMNOPQRSTU"
+
+   if (len (test2 (10)) .ne. 21) call abort ()
+   if (any (test2 (10) .ne. chr)) call abort ()
+end program test
+
+pure function f (x)
+   integer, intent(in) :: x
+   integer f
+
+   f = 2*x+1
+end function f
+! { dg-final { cleanup-modules "test1" } }