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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@126881 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index fbfe389..6445cf1 100644 (file)
--- 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
 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 (file)
--- 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;
 
   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:
   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
    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
 
 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;
 
 {
   gfc_intrinsic_sym *g;
 

-  if (!(gfc_option.allow_std & standard)
-      && gfc_option.flag_all_intrinsics == 0)
-    return;
-

   if (sizing != SZ_NOTHING)
     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
 
 
 /* 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)
 {
 
 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:
   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);
     case SZ_NOTHING:
       next_sym[0] = next_sym[-1];
       next_sym->name = gfc_get_string (name);

+      next_sym->standard = standard;

       next_sym++;
       break;
 
       next_sym++;
       break;
 


@@ -2340,8 +2331,7 @@ add_subroutines (void)
 
   add_sym_0s ("abort", GFC_ISYM_ABORT, GFC_STD_GNU, NULL);
 
 
   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,
 
   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);
 
              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,
 
   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.  */
 
 /* 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)
 {
 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;
     }
 
       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.  */
   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;
 
                        &expr->where) == FAILURE)
     return MATCH_ERROR;
 

-  check_intrinsic_standard (name, isym->standard, &expr->where);
-

   return MATCH_YES;
 }
 
   return MATCH_YES;
 }
 


@@ -3421,6 +3416,9 @@ gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
   if (isym == NULL)
     return MATCH_NO;
 
   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);
   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;
     }
 
   c->resolved_sym->attr.noreturn = isym->noreturn;

-  check_intrinsic_standard (name, isym->standard, &c->loc);

 
   return MATCH_YES;
 
 
   return MATCH_YES;
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 08d34cd..1a75a1f 100644 (file)
--- 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
 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 (file)
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 (file)
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 (file)
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 (file)
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