diff options
author | bstarynk <bstarynk@138bc75d-0d04-0410-961f-82ee72b054a4> | 2009-07-15 11:24:46 +0000 |
---|---|---|
committer | bstarynk <bstarynk@138bc75d-0d04-0410-961f-82ee72b054a4> | 2009-07-15 11:24:46 +0000 |
commit | 56fcd3fede0e1c4489a3c108d95fd1ff38dfa1a5 (patch) | |
tree | f21ec6dd55e434aff16e698b0286153465775d62 /gcc/fortran | |
parent | c2ce85c4e04bda844aa35dfdf41e69e585d97b2e (diff) | |
download | gcc-56fcd3fede0e1c4489a3c108d95fd1ff38dfa1a5.tar.gz |
2009-07-15 Basile Starynkevitch <basile@starynkevitch.net>
MELT branch merged with trunk rev 149655
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@149682 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/fortran')
-rw-r--r-- | gcc/fortran/ChangeLog | 45 | ||||
-rw-r--r-- | gcc/fortran/Make-lang.in | 2 | ||||
-rw-r--r-- | gcc/fortran/check.c | 17 | ||||
-rw-r--r-- | gcc/fortran/intrinsic.c | 8 | ||||
-rw-r--r-- | gcc/fortran/intrinsic.h | 1 | ||||
-rw-r--r-- | gcc/fortran/intrinsic.texi | 33 | ||||
-rw-r--r-- | gcc/fortran/libgfortran.h | 5 | ||||
-rw-r--r-- | gcc/fortran/module.c | 15 | ||||
-rw-r--r-- | gcc/fortran/primary.c | 5 | ||||
-rw-r--r-- | gcc/fortran/resolve.c | 29 | ||||
-rw-r--r-- | gcc/fortran/trans-expr.c | 5 |
11 files changed, 126 insertions, 39 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 5b1ed772829..aaf2c882dc1 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,48 @@ +2009-07-14 Taras Glek <tglek@mozilla.com> + Rafael Espindola <espindola@google.com> + + * Make-lang.in (fortran.install-plugin): New target for + installing plugin headers. + +2009-07-13 H.J. Lu <hongjiu.lu@intel.com> + + * module.c (mio_symbol): Remove the unused variable, formal. + +2009-07-13 Janus Weil <janus@gcc.gnu.org> + + PR fortran/40646 + * module.c (mio_symbol): If the symbol has formal arguments, + the formal namespace will be present. + * resolve.c (resolve_actual_arglist): Correctly handle 'called' + procedure pointer components as actual arguments. + (resolve_fl_derived,resolve_symbol): Make sure the formal namespace + is present. + * trans-expr.c (gfc_conv_procedure_call): Correctly handle the formal + arguments of procedure pointer components. + +2009-07-12 Tobias Burnus <burnus@net-b.de> + Philippe Marguinaud <philippe.marguinaud@meteo.fr> + + PR fortran/40588 + * primary.c (match_charkind_name): Fix condition for $ matching. + + PR libfortran/22423 + * libgfortran.h: Typedef the GFC_DTYPE_* enum. + +2009-07-11 Tobias Burnus <burnus@net-b.de> + + PR fortran/33197 + * check.c (gfc_check_fn_rc2008): New function. + * intrinsic.h (gfc_check_fn_rc2008): New prototype. + * intrinsic.c (add_functions): Add complex tan, cosh, sinh, + and tanh. + +2009-07-10 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/39334 + * primary.c (match_kind_param): Return MATCH_NO if the symbol + has no value. + 2008-07-09 Paul Thomas <pault@gcc.gnu.org> PR fortran/40629 diff --git a/gcc/fortran/Make-lang.in b/gcc/fortran/Make-lang.in index 0ac9bb2262b..38041f09535 100644 --- a/gcc/fortran/Make-lang.in +++ b/gcc/fortran/Make-lang.in @@ -234,6 +234,8 @@ fortran.install-common: install-finclude-dir installdirs fi ; \ fi +fortran.install-plugin: + fortran.install-info: $(DESTDIR)$(infodir)/gfortran.info fortran.install-man: $(DESTDIR)$(man1dir)/$(GFORTRAN_INSTALL_NAME)$(man1ext) diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 103c9417790..8f949d2c093 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -1212,6 +1212,23 @@ gfc_check_fn_rc (gfc_expr *a) gfc_try +gfc_check_fn_rc2008 (gfc_expr *a) +{ + if (real_or_complex_check (a, 0) == FAILURE) + return FAILURE; + + if (a->ts.type == BT_COMPLEX + && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: COMPLEX argument '%s' " + "argument of '%s' intrinsic at %L", + gfc_current_intrinsic_arg[0], gfc_current_intrinsic, + &a->where) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + +gfc_try gfc_check_fnum (gfc_expr *unit) { if (type_check (unit, 0, BT_INTEGER) == FAILURE) diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 9402234b034..a918ddf7d23 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -1440,7 +1440,7 @@ add_functions (void) make_generic ("cos", GFC_ISYM_COS, GFC_STD_F77); add_sym_1 ("cosh", GFC_ISYM_COSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77, - gfc_check_fn_r, gfc_simplify_cosh, gfc_resolve_cosh, + gfc_check_fn_rc2008, gfc_simplify_cosh, gfc_resolve_cosh, x, BT_REAL, dr, REQUIRED); add_sym_1 ("dcosh", GFC_ISYM_COSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77, @@ -2405,7 +2405,7 @@ add_functions (void) make_generic ("sin", GFC_ISYM_SIN, GFC_STD_F77); add_sym_1 ("sinh", GFC_ISYM_SINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77, - gfc_check_fn_r, gfc_simplify_sinh, gfc_resolve_sinh, + gfc_check_fn_rc2008, gfc_simplify_sinh, gfc_resolve_sinh, x, BT_REAL, dr, REQUIRED); add_sym_1 ("dsinh", GFC_ISYM_SINH,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77, @@ -2488,7 +2488,7 @@ add_functions (void) make_generic ("system", GFC_ISYM_SYSTEM, GFC_STD_GNU); add_sym_1 ("tan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77, - gfc_check_fn_r, gfc_simplify_tan, gfc_resolve_tan, + gfc_check_fn_rc2008, gfc_simplify_tan, gfc_resolve_tan, x, BT_REAL, dr, REQUIRED); add_sym_1 ("dtan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77, @@ -2498,7 +2498,7 @@ add_functions (void) make_generic ("tan", GFC_ISYM_TAN, GFC_STD_F77); add_sym_1 ("tanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77, - gfc_check_fn_r, gfc_simplify_tanh, gfc_resolve_tanh, + gfc_check_fn_rc2008, gfc_simplify_tanh, gfc_resolve_tanh, x, BT_REAL, dr, REQUIRED); add_sym_1 ("dtanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77, diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index d1bf846c264..1e2fbd7a027 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -64,6 +64,7 @@ gfc_try gfc_check_fn_c (gfc_expr *); gfc_try gfc_check_fn_d (gfc_expr *); gfc_try gfc_check_fn_r (gfc_expr *); gfc_try gfc_check_fn_rc (gfc_expr *); +gfc_try gfc_check_fn_rc2008 (gfc_expr *); gfc_try gfc_check_fnum (gfc_expr *); gfc_try gfc_check_hostnm (gfc_expr *); gfc_try gfc_check_huge (gfc_expr *); diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi index eb0956adb22..34783b4a5e0 100644 --- a/gcc/fortran/intrinsic.texi +++ b/gcc/fortran/intrinsic.texi @@ -2676,7 +2676,7 @@ Inverse function: @ref{ACOS} @code{COSH(X)} computes the hyperbolic cosine of @var{X}. @item @emph{Standard}: -Fortran 77 and later +Fortran 77 and later, for a complex argument Fortran 2008 or later @item @emph{Class}: Elemental function @@ -2686,14 +2686,14 @@ Elemental function @item @emph{Arguments}: @multitable @columnfractions .15 .70 -@item @var{X} @tab The type shall be @code{REAL}. +@item @var{X} @tab The type shall be @code{REAL} or @code{COMPLEX}. @end multitable @item @emph{Return value}: -The return value is of type @code{REAL} and it is positive -(@math{ \cosh (x) \geq 0 }). For a @code{REAL} argument @var{X}, -@math{ \cosh (x) \geq 1 }. -The return value is of the same kind as @var{X}. +The return value has same type and kind as @var{X}. If @var{X} is +complex, the imaginary part of the result is in radians. If @var{X} +is @code{REAL}, the return value has a lower bound of one, +@math{\cosh (x) \geq 1}. @item @emph{Example}: @smallexample @@ -9820,7 +9820,7 @@ end program test_sin @code{SINH(X)} computes the hyperbolic sine of @var{X}. @item @emph{Standard}: -Fortran 95 and later +Fortran 95 and later, for a complex argument Fortran 2008 or later @item @emph{Class}: Elemental function @@ -9830,11 +9830,11 @@ Elemental function @item @emph{Arguments}: @multitable @columnfractions .15 .70 -@item @var{X} @tab The type shall be @code{REAL}. +@item @var{X} @tab The type shall be @code{REAL} or @code{COMPLEX}. @end multitable @item @emph{Return value}: -The return value is of type @code{REAL}. +The return value has same type and kind as @var{X}. @item @emph{Example}: @smallexample @@ -10508,7 +10508,7 @@ END PROGRAM @code{TAN(X)} computes the tangent of @var{X}. @item @emph{Standard}: -Fortran 77 and later +Fortran 77 and later, for a complex argument Fortran 2008 or later @item @emph{Class}: Elemental function @@ -10518,12 +10518,11 @@ Elemental function @item @emph{Arguments}: @multitable @columnfractions .15 .70 -@item @var{X} @tab The type shall be @code{REAL}. +@item @var{X} @tab The type shall be @code{REAL} or @code{COMPLEX}. @end multitable @item @emph{Return value}: -The return value is of type @code{REAL}. The kind type parameter is -the same as @var{X}. +The return value has same type and kind as @var{X}. @item @emph{Example}: @smallexample @@ -10558,7 +10557,7 @@ end program test_tan @code{TANH(X)} computes the hyperbolic tangent of @var{X}. @item @emph{Standard}: -Fortran 77 and later +Fortran 77 and later, for a complex argument Fortran 2008 or later @item @emph{Class}: Elemental function @@ -10568,11 +10567,13 @@ Elemental function @item @emph{Arguments}: @multitable @columnfractions .15 .70 -@item @var{X} @tab The type shall be @code{REAL}. +@item @var{X} @tab The type shall be @code{REAL} or @code{COMPLEX}. @end multitable @item @emph{Return value}: -The return value is of type @code{REAL} and lies in the range +The return value has same type and kind as @var{X}. If @var{X} is +complex, the imaginary part of the result is in radians. If @var{X} +is @code{REAL}, the return value lies in the range @math{ - 1 \leq tanh(x) \leq 1 }. @item @emph{Example}: diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h index a18fdce2e88..d66020717a4 100644 --- a/gcc/fortran/libgfortran.h +++ b/gcc/fortran/libgfortran.h @@ -110,7 +110,7 @@ libgfortran_error_codes; #define GFC_DTYPE_TYPE_MASK 0x38 #define GFC_DTYPE_SIZE_SHIFT 6 -enum +typedef enum { GFC_DTYPE_UNKNOWN = 0, GFC_DTYPE_INTEGER, @@ -120,5 +120,6 @@ enum GFC_DTYPE_COMPLEX, GFC_DTYPE_DERIVED, GFC_DTYPE_CHARACTER -}; +} +dtype; diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 7e6e8ff93c4..f16f8d3f72e 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -3432,26 +3432,13 @@ mio_symbol (gfc_symbol *sym) { int intmod = INTMOD_NONE; - gfc_formal_arglist *formal; - mio_lparen (); mio_symbol_attribute (&sym->attr); mio_typespec (&sym->ts); - /* Contained procedures don't have formal namespaces. Instead we output the - procedure namespace. The will contain the formal arguments. */ if (iomode == IO_OUTPUT) - { - formal = sym->formal; - while (formal && !formal->sym) - formal = formal->next; - - if (formal) - mio_namespace_ref (&formal->sym->ns); - else - mio_namespace_ref (&sym->formal_ns); - } + mio_namespace_ref (&sym->formal_ns); else { mio_namespace_ref (&sym->formal_ns); diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 4a84aedbc30..0d52c6c0940 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -57,6 +57,9 @@ match_kind_param (int *kind) if (sym->attr.flavor != FL_PARAMETER) return MATCH_NO; + if (sym->value == NULL) + return MATCH_NO; + p = gfc_extract_int (sym->value, kind); if (p != NULL) return MATCH_NO; @@ -829,7 +832,7 @@ match_charkind_name (char *name) if (!ISALNUM (c) && c != '_' - && (gfc_option.flag_dollar_ok && c != '$')) + && (c != '$' || !gfc_option.flag_dollar_ok)) break; *name++ = c; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 9b091ad0162..880dfd0e886 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1239,7 +1239,14 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype, if (gfc_is_proc_ptr_comp (e, &comp)) { e->ts = comp->ts; - e->expr_type = EXPR_VARIABLE; + if (e->value.compcall.actual == NULL) + e->expr_type = EXPR_VARIABLE; + else + { + if (comp->as != NULL) + e->rank = comp->as->rank; + e->expr_type = EXPR_FUNCTION; + } goto argument_list; } @@ -8993,6 +9000,9 @@ ensure_not_abstract (gfc_symbol* sub, gfc_symbol* ancestor) } +static void resolve_symbol (gfc_symbol *sym); + + /* Resolve the components of a derived type. */ static gfc_try @@ -9031,6 +9041,9 @@ resolve_fl_derived (gfc_symbol *sym) { gfc_symbol *ifc = c->ts.interface; + if (ifc->formal && !ifc->formal_ns) + resolve_symbol (ifc); + if (ifc->attr.intrinsic) resolve_intrinsic (ifc, &ifc->declared_at); @@ -9832,6 +9845,20 @@ resolve_symbol (gfc_symbol *sym) if (sym->formal_ns && sym->formal_ns != gfc_current_ns) gfc_resolve (sym->formal_ns); + /* Make sure the formal namespace is present. */ + if (sym->formal && !sym->formal_ns) + { + gfc_formal_arglist *formal = sym->formal; + while (formal && !formal->sym) + formal = formal->next; + + if (formal) + { + sym->formal_ns = formal->sym->ns; + sym->formal_ns->refs++; + } + } + /* Check threadprivate restrictions. */ if (sym->attr.threadprivate && !sym->attr.save && !sym->ns->save_all && (!sym->attr.in_common diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index b6a825a8125..787251d7627 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -2560,7 +2560,10 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, != EXPR_CONSTANT) || (comp && comp->attr.dimension) || (!comp && sym->attr.dimension)); - formal = sym->formal; + if (comp) + formal = comp->formal; + else + formal = sym->formal; /* Evaluate the arguments. */ for (; arg != NULL; arg = arg->next, formal = formal ? formal->next : NULL) { |