[patch, fortran] PR20373 - intrinsic symbols can be given the wrong type (take 3)

[Daniel Franke <franke dot daniel at gmail dot com>]

Following a private discussion with Janne and Paul's comments on the list, I 
changed my last proposal slightly:

The warning for _any_ type specified together with an INTRINSIC keyword now 
reads:

	INTEGER, INTRINSIC :: SIN
	                        1
	Warning: Type specified for intrinsic function 'sin' at (1) is ignored

Reasoning: 
  * comparing with the internally available type may give spurious
    warnings (e.g. "complex, intrinsic :: sum"; SUM has default type REAL)
  * enumerating allowed types for each intrinsic is not an option
  * the specified type IS ignored
  * the behaviour is consistent with that of the SUN compiler


The testcase was adjusted accordingly. Further, the patch is now correctly 
tabified.

If there are no objections, I will commit after 48 hours.


gcc/fortran:
2007-06-20 ?Daniel Franke ?<franke.daniel@gmail.com>

 ??????PR fortran/20373
 ? ? ? * intrinsic.c (add_functions): Additional function types.
 ??????* resolve.c (resolve_symbol): Added type checks to explicitly defined
 ??????intrinsics.

gcc/testsuite:
2007-06-20 ?Daniel Franke ?<franke.daniel@gmail.com>

 ??????PR fortran/20373
 ??????* gfortran.dg/intrinsic.f90: New test.


Regards
	Daniel

Index: fortran/intrinsic.c
===================================================================
--- fortran/intrinsic.c	(revision 125720)
+++ 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);
 
@@ -1776,7 +1776,7 @@
   /* Note: amax0 is equivalent to real(max), max1 is equivalent to
      int(max).  The max function must take at least two arguments.  */
 
-  add_sym_1m ("max", GFC_ISYM_MAX, ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
+  add_sym_1m ("max", GFC_ISYM_MAX, ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
 	     gfc_check_min_max, gfc_simplify_max, gfc_resolve_max,
 	     a1, BT_UNKNOWN, dr, REQUIRED, a2, BT_UNKNOWN, dr, REQUIRED);
 
@@ -1842,7 +1842,7 @@
   /* Note: amin0 is equivalent to real(min), min1 is equivalent to
      int(min).  */
 
-  add_sym_1m ("min", GFC_ISYM_MIN, ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
+  add_sym_1m ("min", GFC_ISYM_MIN, ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
 	      gfc_check_min_max, gfc_simplify_min, gfc_resolve_min,
 	      a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, 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);
 
Index: fortran/resolve.c
===================================================================
--- fortran/resolve.c	(revision 125720)
+++ fortran/resolve.c	(working copy)
@@ -6266,6 +6266,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)
     {
@@ -6402,12 +6430,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