diff options
| author | Tobias Burnus <burnus@net-b.de> | 2013-04-16 22:54:21 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2013-04-16 22:54:21 +0200 |
| commit | e7ac6a7cebc7af45319ac1b88d3f6071f0fed49e (patch) | |
| tree | ae48f47ebf76afba5e32eeb6ff8fdc0fcb516a97 /gcc/fortran/interface.c | |
| parent | bafa0782ad3ba8e5c92196b00d76b38d69e3e1e1 (diff) | |
| download | gcc-e7ac6a7cebc7af45319ac1b88d3f6071f0fed49e.zip gcc-e7ac6a7cebc7af45319ac1b88d3f6071f0fed49e.tar.gz gcc-e7ac6a7cebc7af45319ac1b88d3f6071f0fed49e.tar.bz2 | |
re PR fortran/39505 (Consider a 'no arg check' directive)
2013-04-12 Tobias Burnus <burnus@net-b.de>
PR fortran/39505
* decl.c (ext_attr_list): Add EXT_ATTR_NO_ARG_CHECK.
* gfortran.h (ext_attr_id_t): Ditto.
* gfortran.texi (GNU Fortran Compiler Directives):
Document it.
* interface.c (compare_type_rank): Ignore rank for NO_ARG_CHECK.
(compare_parameter): Ditto - and regard as unlimited polymorphic.
* resolve.c (resolve_symbol, resolve_variable): Add same
* constraint
checks as for TYPE(*); turn dummy to TYPE(*),dimension(*).
(gfc_explicit_interface_required): Require explicit interface
for NO_ARG_CHECK.
2013-04-12 Tobias Burnus <burnus@net-b.de>
PR fortran/39505
* gfortran.dg/no_arg_check_1.f90: New.
* gfortran.dg/no_arg_check_2.f90: New.
* gfortran.dg/no_arg_check_3.f90: New.
From-SVN: r198011
Diffstat (limited to 'gcc/fortran/interface.c')
| -rw-r--r-- | gcc/fortran/interface.c | 9 |
1 files changed, 9 insertions, 0 deletions
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 7414164..8f7cad7 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -518,6 +518,10 @@ compare_type_rank (gfc_symbol *s1, gfc_symbol *s2) gfc_array_spec *as1, *as2; int r1, r2; + if (s1->attr.ext_attr & (1 << EXT_ATTR_NO_ARG_CHECK) + || s2->attr.ext_attr & (1 << EXT_ATTR_NO_ARG_CHECK)) + return 1; + as1 = (s1->ts.type == BT_CLASS) ? CLASS_DATA (s1)->as : s1->as; as2 = (s2->ts.type == BT_CLASS) ? CLASS_DATA (s2)->as : s2->as; @@ -1900,6 +1904,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, if ((actual->expr_type != EXPR_NULL || actual->ts.type != BT_UNKNOWN) && actual->ts.type != BT_HOLLERITH && formal->ts.type != BT_ASSUMED + && !(formal->attr.ext_attr & (1 << EXT_ATTR_NO_ARG_CHECK)) && !gfc_compare_types (&formal->ts, &actual->ts) && !(formal->ts.type == BT_DERIVED && actual->ts.type == BT_CLASS && gfc_compare_derived_types (formal->ts.u.derived, @@ -2060,6 +2065,10 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, || formal->as->type == AS_DEFERRED) && actual->expr_type != EXPR_NULL; + /* Skip rank checks for NO_ARG_CHECK. */ + if (formal->attr.ext_attr & (1 << EXT_ATTR_NO_ARG_CHECK)) + return 1; + /* Scalar & coindexed, see: F2008, Section 12.5.2.4. */ if (rank_check || ranks_must_agree || (formal->attr.pointer && actual->expr_type != EXPR_NULL) |