OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
This commit is contained in:
Daniel Franke 2007-07-24 12:45:32 -04:00 committed by Daniel Franke
parent 78187f5ad2
commit 3f2286f2a3
7 changed files with 125 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/fortran/ChangeLog
View File

@ -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

63
gcc/fortran/intrinsic.c
View File

@ -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;

8
gcc/testsuite/ChangeLog
View File

@ -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

15
gcc/testsuite/gfortran.dg/imag_2.f
View File

@ -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

25
gcc/testsuite/gfortran.dg/warn_std_1.f90 Normal file
View File

@ -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

25
gcc/testsuite/gfortran.dg/warn_std_2.f90 Normal file
View File

@ -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

25
gcc/testsuite/gfortran.dg/warn_std_3.f90 Normal file
View File

@ -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