re PR fortran/32778 (pedantic warning: intrinsics that are GNU extensions not part of -std=gnu)

gcc/fortran:
2007-07-24  Daniel Franke  <franke.daniel@gmail.com>

	PR fortran/32778
	* intrinsic.c (add_sym): Do not exclude any symbols, even if not part
	of the selected standard.
	(make generic): Likewise.
	(make alias): Likewise, set standard the alias belongs to.
	(add_subroutines): Call make_noreturn unconditionally.
	(check_intrinsic_standard): Change return value to try.
	(gfc_intrinsic_func_interface): Check return value of above function.
	(gfc_intrinsic_sub_interface): Likewise.

gcc/testsuite:
2007-07-24  Daniel Franke  <franke.daniel@gmail.com>

	PR fortran/32778
	* gfortran.dg/imag_2.f: Removed
	* gfortran.dg/warn_std_1.f90: New test.
	* gfortran.dg/warn_std_2.f90: New test.
	* gfortran.dg/warn_std_3.f90: New test.

From-SVN: r126881

7 files changed, 125 insertions, 48 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index fbfe389..6445cf1 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,15 @@
+2007-07-24  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/32778
+	* intrinsic.c (add_sym): Do not exclude any symbols, even if not part
+	of the selected standard.
+	(make generic): Likewise.
+	(make alias): Likewise, set standard the alias belongs to.
+	(add_subroutines): Call make_noreturn unconditionally.
+	(check_intrinsic_standard): Change return value to try.
+	(gfc_intrinsic_func_interface): Check return value of above function.
+	(gfc_intrinsic_sub_interface): Likewise.
+
 2007-07-24  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/30814
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index e71a023..0b062b5 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -228,12 +228,6 @@ add_sym (const char *name, gfc_isym_id id, enum class cl, int actual_ok, bt type
   int optional, first_flag;
   va_list argp;
 
-  /* First check that the intrinsic belongs to the selected standard.
-     If not, don't add it to the symbol list.  */
-  if (!(gfc_option.allow_std & standard)
-      && gfc_option.flag_all_intrinsics == 0)
-    return;
-
   switch (sizing)
     {
     case SZ_SUBS:
@@ -806,17 +800,18 @@ gfc_intrinsic_name (const char *name, int subroutine_flag)
    The first argument is the name of the generic function, which is
    also the name of a specific function.  The rest of the specifics
    currently in the table are placed into the list of specific
-   functions associated with that generic.  */
+   functions associated with that generic.
+
+   PR fortran/32778
+   FIXME: Remove the argument STANDARD if no regressions are
+          encountered. Change all callers (approx. 360).
+*/
 
 static void
-make_generic (const char *name, gfc_isym_id id, int standard)
+make_generic (const char *name, gfc_isym_id id, int standard ATTRIBUTE_UNUSED)
 {
   gfc_intrinsic_sym *g;
 
-  if (!(gfc_option.allow_std & standard)
-      && gfc_option.flag_all_intrinsics == 0)
-    return;
-
   if (sizing != SZ_NOTHING)
     return;
 
@@ -848,19 +843,14 @@ make_generic (const char *name, gfc_isym_id id, int standard)
 
 
 /* Create a duplicate intrinsic function entry for the current
-   function, the only difference being the alternate name.  Note that
-   we use argument lists more than once, but all argument lists are
-   freed as a single block.  */
+   function, the only differences being the alternate name and
+   a different standard if necessary. Note that we use argument
+   lists more than once, but all argument lists are freed as a
+   single block.  */
 
 static void
 make_alias (const char *name, int standard)
 {
-  /* First check that the intrinsic belongs to the selected standard.
-     If not, don't add it to the symbol list.  */
-  if (!(gfc_option.allow_std & standard)
-      && gfc_option.flag_all_intrinsics == 0)
-    return;
-
   switch (sizing)
     {
     case SZ_FUNCS:
@@ -874,6 +864,7 @@ make_alias (const char *name, int standard)
     case SZ_NOTHING:
       next_sym[0] = next_sym[-1];
       next_sym->name = gfc_get_string (name);
+      next_sym->standard = standard;
       next_sym++;
       break;
 
@@ -2340,8 +2331,7 @@ add_subroutines (void)
 
   add_sym_0s ("abort", GFC_ISYM_ABORT, GFC_STD_GNU, NULL);
 
-  if ((gfc_option.allow_std & GFC_STD_GNU) || gfc_option.flag_all_intrinsics)
-    make_noreturn();
+  make_noreturn();
 
   add_sym_1s ("cpu_time", GFC_ISYM_CPU_TIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F95,
 	      gfc_check_cpu_time, NULL, gfc_resolve_cpu_time,
@@ -2476,8 +2466,7 @@ add_subroutines (void)
 	      gfc_check_exit, NULL, gfc_resolve_exit,
 	      st, BT_INTEGER, di, OPTIONAL);
 
-  if ((gfc_option.allow_std & GFC_STD_GNU) || gfc_option.flag_all_intrinsics)
-    make_noreturn();
+  make_noreturn();
 
   add_sym_3s ("fgetc", GFC_ISYM_FGETC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
 	      gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub,
@@ -3278,14 +3267,19 @@ check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
 /* Check whether an intrinsic belongs to whatever standard the user
    has chosen.  */
 
-static void
+static try
 check_intrinsic_standard (const char *name, int standard, locus *where)
 {
-  if (!gfc_option.warn_nonstd_intrinsics)
-    return;
+  /* Do not warn about GNU-extensions if -std=gnu.  */
+  if (!gfc_option.warn_nonstd_intrinsics
+      || (standard == GFC_STD_GNU && gfc_option.warn_std & GFC_STD_GNU))
+    return SUCCESS;
 
-  gfc_notify_std (standard, "Intrinsic '%s' at %L is not included "
-		  "in the selected standard", name, where);
+  if (gfc_notify_std (standard, "Intrinsic '%s' at %L is not included "
+		      "in the selected standard", name, where) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
 }
 
 
@@ -3331,6 +3325,9 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
       return MATCH_NO;
     }
 
+  if (check_intrinsic_standard (name, isym->standard, &expr->where) == FAILURE)
+    return MATCH_ERROR;
+
   gfc_current_intrinsic_where = &expr->where;
 
   /* Bypass the generic list for min and max.  */
@@ -3398,8 +3395,6 @@ got_specific:
 			&expr->where) == FAILURE)
     return MATCH_ERROR;
 
-  check_intrinsic_standard (name, isym->standard, &expr->where);
-
   return MATCH_YES;
 }
 
@@ -3421,6 +3416,9 @@ gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
   if (isym == NULL)
     return MATCH_NO;
 
+  if (check_intrinsic_standard (name, isym->standard, &c->loc) == FAILURE)
+    return MATCH_ERROR;
+
   gfc_suppress_error = !error_flag;
 
   init_arglist (isym);
@@ -3456,7 +3454,6 @@ gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
     }
 
   c->resolved_sym->attr.noreturn = isym->noreturn;
-  check_intrinsic_standard (name, isym->standard, &c->loc);
 
   return MATCH_YES;
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 08d34cd..1a75a1f 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2007-07-24  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/32778
+	* gfortran.dg/imag_2.f: Removed
+	* gfortran.dg/warn_std_1.f90: New test.
+	* gfortran.dg/warn_std_2.f90: New test.
+	* gfortran.dg/warn_std_3.f90: New test.
+
 2007-07-24  Paolo Carlini  <pcarlini@suse.de>
 
 	PR c++/29001
diff --git a/gcc/testsuite/gfortran.dg/imag_2.f b/gcc/testsuite/gfortran.dg/imag_2.f
deleted file mode 100644
index 137f089..0000000
--- a/gcc/testsuite/gfortran.dg/imag_2.f
+++ /dev/null
@@ -1,15 +0,0 @@
-! { dg-do compile }
-! { dg-options "-std=f95" }
-      program bug
-      implicit none
-      complex(kind=8) z
-      double precision x
-      z = cmplx(1.e0_8, 2.e0_8)
-      x = imag(z)         ! { dg-error "has no IMPLICIT type" "" }
-      x = imagpart(z)     ! { dg-error "has no IMPLICIT type" "" }
-      x = realpart(z)     ! { dg-error "has no IMPLICIT type" "" }
-      x = imag(x)         ! { dg-error "has no IMPLICIT type" "" }
-      x = imagpart(x)     ! { dg-error "has no IMPLICIT type" "" }
-      x = realpart(x)     ! { dg-error "has no IMPLICIT type" "" }
-      end
-
diff --git a/gcc/testsuite/gfortran.dg/warn_std_1.f90 b/gcc/testsuite/gfortran.dg/warn_std_1.f90
new file mode 100644
index 0000000..4d709a1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warn_std_1.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! { dg-options "-Wnonstd-intrinsics -std=gnu" }
+!
+! PR fortran/32778 - pedantic warning: intrinsics that 
+!                    are GNU extensions not part of -std=gnu
+!
+! (1/3) Check for excess errors if -std=gnu.
+!
+
+CHARACTER(len=255) :: tmp
+REAL(8) :: x
+
+! GNU extension, check overload of F77 standard intrinsic
+x = ZABS(CMPLX(0.0, 1.0, 8))
+
+! GNU extension
+CALL flush()
+
+! F95
+tmp = ADJUSTL("  gfortran  ")
+
+! F2003
+CALL GET_COMMAND (tmp)
+
+END
diff --git a/gcc/testsuite/gfortran.dg/warn_std_2.f90 b/gcc/testsuite/gfortran.dg/warn_std_2.f90
new file mode 100644
index 0000000..0a8c509
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warn_std_2.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! { dg-options "-Wnonstd-intrinsics -std=f95" }
+!
+! PR fortran/32778 - pedantic warning: intrinsics that 
+!                    are GNU extensions not part of -std=gnu
+!
+! (2/3) Check for GNU extensions and intrinsics from F2003 if -std=f95.
+!
+
+CHARACTER(len=255) :: tmp
+REAL(8) :: x
+
+! GNU extension, check overload of F77 standard intrinsic
+x = ZABS(CMPLX(0.0, 1.0, 8))    ! { dg-error "is not included in the selected standard" }
+
+! GNU extension
+CALL flush()                    ! { dg-error "is not included in the selected standard" }
+
+! F95
+tmp = ADJUSTL("  gfortran  ")
+
+! F2003
+CALL GET_COMMAND (tmp)          ! { dg-error "is not included in the selected standard" }
+
+END
diff --git a/gcc/testsuite/gfortran.dg/warn_std_3.f90 b/gcc/testsuite/gfortran.dg/warn_std_3.f90
new file mode 100644
index 0000000..0d0a0f1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warn_std_3.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! { dg-options "-Wnonstd-intrinsics -std=f2003" }
+!
+! PR fortran/32778 - pedantic warning: intrinsics that 
+!                    are GNU extensions not part of -std=gnu
+!
+! (3/3) Check for GNU extensions if -std=f2003.
+!
+
+CHARACTER(len=255) :: tmp
+REAL(8) :: x
+
+! GNU extension, check overload of F77 standard intrinsic
+x = ZABS(CMPLX(0.0, 1.0, 8))    ! { dg-error "is not included in the selected standard" }
+
+! GNU extension
+CALL flush()                    ! { dg-error "is not included in the selected standard" }
+
+! F95
+tmp = ADJUSTL("  gfortran  ")
+
+! F2003
+CALL GET_COMMAND (tmp)
+
+END