re PR fortran/20373 (INTRINSIC symbols can be given the wrong type)
gcc/fortran: 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. gcc/testsuite: 2007-06-28 Daniel Franke <franke.daniel@gmail.com> PR fortran/20373 * gfortran.dg/intrinsic.f90: New test. From-SVN: r126153
This commit is contained in:
Daniel Franke
Daniel Franke
parent
df5be068b2
commit
eb2c598d55
5 changed files with 85 additions and 14 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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. */
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
36
gcc/testsuite/gfortran.dg/intrinsic.f90
Normal file
36
gcc/testsuite/gfortran.dg/intrinsic.f90
Normal file
|
|
@ -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
|
||||
Loading…
Add table
Reference in a new issue