This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
Re: [patch, fortran] PR20373 again ...
- From: Daniel Franke <franke dot daniel at gmail dot com>
- To: fortran at gcc dot gnu dot org
- Cc: gcc-patches at gcc dot gnu dot org
- Date: Thu, 28 Jun 2007 20:23:28 +0200
- Subject: Re: [patch, fortran] PR20373 again ...
- References: <200706282022.33734.franke.daniel@gmail.com>
On Thursday 28 June 2007 20:22:33 Daniel Franke wrote:
> gcc/fortran:
> 2007-06-28 Daniel Franke <franke.daniel@gmail.com>
>
> PR fortran/20373
> * intrinsic.c (add_functions): Additional function types.
> (gfc_convert_type_warn): Remove intrinsic-flag from conversion
> functions.
> * resolve.c (resolve_symbol): Added type checks to explicitly defined
> intrinsics.
>
> gcc/testsuite:
> 2007-06-28 Daniel Franke <franke.daniel@gmail.com>
>
> PR fortran/20373
> * gfortran.dg/intrinsic.f90: New test.
And with patch ...
Index: fortran/intrinsic.c
===================================================================
--- fortran/intrinsic.c (revision 126079)
+++ fortran/intrinsic.c (working copy)
@@ -1014,7 +1014,7 @@
make_generic ("aint", GFC_ISYM_AINT, GFC_STD_F77);
- add_sym_2 ("all", GFC_ISYM_ALL, NOT_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F95,
+ add_sym_2 ("all", GFC_ISYM_ALL, NOT_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
gfc_check_all_any, NULL, gfc_resolve_all,
msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
@@ -1036,7 +1036,7 @@
make_generic ("anint", GFC_ISYM_ANINT, GFC_STD_F77);
- add_sym_2 ("any", GFC_ISYM_ANY, NOT_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F95,
+ add_sym_2 ("any", GFC_ISYM_ANY, NOT_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
gfc_check_all_any, NULL, gfc_resolve_any,
msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
@@ -1310,7 +1310,7 @@
make_generic ("dim", GFC_ISYM_DIM, GFC_STD_F77);
- add_sym_2 ("dot_product", GFC_ISYM_DOT_PRODUCT, NOT_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0,
+ add_sym_2 ("dot_product", GFC_ISYM_DOT_PRODUCT, NOT_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
GFC_STD_F95, gfc_check_dot_product, NULL, gfc_resolve_dot_product,
va, BT_REAL, dr, REQUIRED, vb, BT_REAL, dr, REQUIRED);
@@ -1503,7 +1503,7 @@
make_generic ("iand", GFC_ISYM_IAND, GFC_STD_F95);
- add_sym_2 ("and", GFC_ISYM_AND, NOT_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_GNU,
+ add_sym_2 ("and", GFC_ISYM_AND, NOT_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
gfc_check_and, gfc_simplify_and, gfc_resolve_and,
i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
@@ -1545,7 +1545,7 @@
make_generic ("ieor", GFC_ISYM_IEOR, GFC_STD_F95);
- add_sym_2 ("xor", GFC_ISYM_XOR, NOT_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_GNU,
+ add_sym_2 ("xor", GFC_ISYM_XOR, NOT_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
gfc_check_and, gfc_simplify_xor, gfc_resolve_xor,
i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
@@ -1605,7 +1605,7 @@
make_generic ("ior", GFC_ISYM_IOR, GFC_STD_F95);
- add_sym_2 ("or", GFC_ISYM_OR, NOT_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_GNU,
+ add_sym_2 ("or", GFC_ISYM_OR, NOT_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
gfc_check_and, gfc_simplify_or, gfc_resolve_or,
i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
@@ -2188,7 +2188,7 @@
make_generic ("stat", GFC_ISYM_STAT, GFC_STD_GNU);
- add_sym_3red ("sum", GFC_ISYM_SUM, NOT_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F95,
+ add_sym_3red ("sum", GFC_ISYM_SUM, NOT_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
gfc_check_product_sum, NULL, gfc_resolve_sum,
ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
msk, BT_LOGICAL, dl, OPTIONAL);
@@ -3562,7 +3562,6 @@
new->symtree->n.sym->ts = *ts;
new->symtree->n.sym->attr.flavor = FL_PROCEDURE;
new->symtree->n.sym->attr.function = 1;
- new->symtree->n.sym->attr.intrinsic = 1;
new->symtree->n.sym->attr.elemental = 1;
new->symtree->n.sym->attr.pure = 1;
new->symtree->n.sym->attr.referenced = 1;
Index: fortran/resolve.c
===================================================================
--- fortran/resolve.c (revision 126079)
+++ fortran/resolve.c (working copy)
@@ -6280,6 +6280,34 @@
can. */
mp_flag = (sym->result != NULL && sym->result != sym);
+
+ /* Make sure that the intrinsic is consistent with its internal
+ representation. This needs to be done before assigning a default
+ type to avoid spurious warnings. */
+ if (sym->attr.flavor != FL_MODULE && sym->attr.intrinsic)
+ {
+ if (gfc_intrinsic_name (sym->name, 0))
+ {
+ if (sym->ts.type != BT_UNKNOWN && gfc_option.warn_surprising)
+ gfc_warning ("Type specified for intrinsic function '%s' at %L is ignored",
+ sym->name, &sym->declared_at);
+ }
+ else if (gfc_intrinsic_name (sym->name, 1))
+ {
+ if (sym->ts.type != BT_UNKNOWN)
+ {
+ gfc_error ("Intrinsic subroutine '%s' at %L shall not have a type specifier",
+ sym->name, &sym->declared_at);
+ return;
+ }
+ }
+ else
+ {
+ gfc_error ("Intrinsic '%s' at %L does not exist", sym->name, &sym->declared_at);
+ return;
+ }
+ }
+
/* Assign default type to symbols that need one and don't have one. */
if (sym->ts.type == BT_UNKNOWN)
{
@@ -6416,12 +6444,6 @@
break;
}
- /* Make sure that intrinsic exist */
- if (sym->attr.flavor != FL_MODULE && sym->attr.intrinsic
- && !gfc_intrinsic_name(sym->name, 0)
- && !gfc_intrinsic_name(sym->name, 1))
- gfc_error("Intrinsic at %L does not exist", &sym->declared_at);
-
/* Resolve array specifier. Check as well some constraints
on COMMON blocks. */
Index: testsuite/gfortran.dg/intrinsic.f90
===================================================================
--- testsuite/gfortran.dg/intrinsic.f90 (revision 0)
+++ testsuite/gfortran.dg/intrinsic.f90 (revision 0)
@@ -0,0 +1,36 @@
+! { dg-do compile }
+! { dg-options "-c -Wall" }
+
+subroutine valid
+ intrinsic :: abs ! ok, intrinsic function
+ intrinsic :: cpu_time ! ok, intrinsic subroutine
+end subroutine
+
+subroutine warnings
+ ! the follow three are ok in general, but ANY
+ ! type is ignored, even the correct one
+ real, intrinsic :: sin ! { dg-warning "is ignored" }
+
+ real :: asin ! { dg-warning "is ignored" }
+ intrinsic :: asin
+
+ intrinsic :: tan ! { dg-warning "is ignored" }
+ real :: tan
+
+ ! wrong types here
+ integer, intrinsic :: cos ! { dg-warning "is ignored" }
+
+ integer :: acos ! { dg-warning "is ignored" }
+ intrinsic :: acos
+
+ ! ordering shall not matter
+ intrinsic :: atan ! { dg-warning "is ignored" }
+ integer :: atan
+end subroutine
+
+subroutine errors
+ intrinsic :: foo ! { dg-error "does not exist" }
+ real, intrinsic :: bar ! { dg-error "does not exist" }
+
+ real, intrinsic :: mvbits ! { dg-error "shall not have a type" }
+end subroutine