From e9bd9f7d5db94db21cdd566e9e00f851563edc97 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sat, 7 Apr 2007 20:13:52 +0000 Subject: [PATCH] re PR fortran/31293 (Implicit character and array returning functions) 2007-04-07 Paul Thomas 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 PR fortran/31293 * gfortran.dg/interface_12.f90: New test. From-SVN: r123641 --- gcc/fortran/ChangeLog | 8 +++ gcc/fortran/gfortran.h | 4 +- gcc/fortran/parse.c | 3 + gcc/fortran/symbol.c | 31 ++++++++++ gcc/testsuite/ChangeLog | 5 ++ gcc/testsuite/gfortran.dg/interface_12.f90 | 90 ++++++++++++++++++++++++++++++ 6 files changed, 140 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/interface_12.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 5b3001f..e72aa0d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2007-04-07 Paul Thomas + + 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 PR fortran/31483 diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 3ef4902..e9c71cd 100644 --- 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 --- 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 --- 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 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2007-04-07 Paul Thomas + + PR fortran/31293 + * gfortran.dg/interface_12.f90: New test. + 2007-04-07 Bruce Korb * 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 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" } } -- 2.7.4