diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 19ab39117fa8de31e5f4e047d0741e72f72bc36f..7c0618d266ea508dc2f9ff1a623fda12f12dc648 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2007-06-30 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.
+
2007-06-30 Tobias Burnus <burnus@net-b.de>
PR fortran/32555
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 69d296ac9d9f68d4492883c2846ef4af2cad484b..7fbda184af4889deca5d71bd47b68c1781e48830 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -1014,7 +1014,7 @@ add_functions (void)
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 @@ add_functions (void)
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 @@ add_functions (void)
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 @@ add_functions (void)
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 @@ add_functions (void)
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 @@ add_functions (void)
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 @@ add_functions (void)
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 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
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;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 8cc0c421193f868c09c2587298d6545815b5ac8a..43711cd126df3ef76d6b0b86d78a2fcff0f34b2a 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -6282,6 +6282,34 @@ resolve_symbol (gfc_symbol *sym)
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)
{
@@ -6418,12 +6446,6 @@ resolve_symbol (gfc_symbol *sym)
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. */
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d6a6dba26ebd8990261dbfb5b8587aa0f7c2f83f..59237fa91f52fa8ba0463d62dae2a4d202ada735 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-06-30 Daniel Franke <franke.daniel@gmail.com>
+
+ PR fortran/20373
+ * gfortran.dg/intrinsic.f90: New test.
+
2007-06-30 Tobias Burnus <burnus@net-b.de>
PR fortran/32555
diff --git a/gcc/testsuite/gfortran.dg/intrinsic.f90 b/gcc/testsuite/gfortran.dg/intrinsic.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8bb41fdfdc42a2a6a617520a897a221a393a3446
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic.f90
@@ -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