diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 35 | ||||
| -rw-r--r-- | gcc/fortran/check.c | 49 | ||||
| -rw-r--r-- | gcc/fortran/intrinsic.c | 7 | ||||
| -rw-r--r-- | gcc/fortran/intrinsic.h | 2 | ||||
| -rw-r--r-- | gcc/fortran/intrinsic.texi | 2 | ||||
| -rw-r--r-- | gcc/fortran/simplify.c | 79 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/sizeof_2.f90 | 24 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/sizeof_3.f90 | 45 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/sizeof_proc.f90 | 8 |
10 files changed, 237 insertions, 22 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 0426dff..a32aedb 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,17 +1,30 @@ +2013-03-27 Tobias Burnus <burnus@net-b.de> + + PR fortran/56650 + PR fortran/36437 + * check.c (gfc_check_sizeof, gfc_check_c_sizeof, + gfc_check_storage_size): Update checks. + * intrinsic.texi (SIZEOF): Correct class. + * intrinsic.h (gfc_simplify_sizeof, + gfc_simplify_storage_size): New prototypes. + * intrinsic.c (add_functions): Use them. + * simplify.c (gfc_simplify_sizeof, + gfc_simplify_storage_size): New functions. + 2013-03-27 Janne Blomqvist <jb@gcc.gnu.org> PR fortran/25708 - * module.c (module_locus): Use long for position. - (module_content): New variable. - (module_pos): Likewise. - (prev_character): Remove. - (bad_module): Free data instead of closing mod file. - (set_module_locus): Use module_pos. - (get_module_locus): Likewise. - (module_char): use buffer rather than stdio file. - (module_unget_char): Likewise. - (read_module_to_tmpbuf): New function. - (gfc_use_module): Call read_module_to_tmpbuf. + * module.c (module_locus): Use long for position. + (module_content): New variable. + (module_pos): Likewise. + (prev_character): Remove. + (bad_module): Free data instead of closing mod file. + (set_module_locus): Use module_pos. + (get_module_locus): Likewise. + (module_char): use buffer rather than stdio file. + (module_unget_char): Likewise. + (read_module_to_tmpbuf): New function. + (gfc_use_module): Call read_module_to_tmpbuf. 2013-03-26 Tobias Burnus <burnus@net-b.de> diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 0460bf2..99174bc 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -3617,11 +3617,31 @@ gfc_check_sizeof (gfc_expr *arg) { if (arg->ts.type == BT_PROCEDURE) { - gfc_error ("'%s' argument of '%s' intrinsic at %L may not be a procedure", + gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be a procedure", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &arg->where); return FAILURE; } + + if (arg->ts.type == BT_ASSUMED) + { + gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be TYPE(*)", + gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, + &arg->where); + return FAILURE; + } + + if (arg->rank && arg->expr_type == EXPR_VARIABLE + && arg->symtree->n.sym->as != NULL + && arg->symtree->n.sym->as->type == AS_ASSUMED_SIZE && arg->ref + && arg->ref->type == REF_ARRAY && arg->ref->u.ar.type == AR_FULL) + { + gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be an " + "assumed-size array", gfc_current_intrinsic_arg[0]->name, + gfc_current_intrinsic, &arg->where); + return FAILURE; + } + return SUCCESS; } @@ -3739,6 +3759,15 @@ gfc_check_c_sizeof (gfc_expr *arg) return FAILURE; } + if (arg->ts.type == BT_ASSUMED) + { + gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be " + "TYPE(*)", + gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, + &arg->where); + return FAILURE; + } + if (arg->rank && arg->expr_type == EXPR_VARIABLE && arg->symtree->n.sym->as != NULL && arg->symtree->n.sym->as->type == AS_ASSUMED_SIZE && arg->ref @@ -5593,8 +5622,24 @@ gfc_check_and (gfc_expr *i, gfc_expr *j) gfc_try -gfc_check_storage_size (gfc_expr *a ATTRIBUTE_UNUSED, gfc_expr *kind) +gfc_check_storage_size (gfc_expr *a, gfc_expr *kind) { + if (a->ts.type == BT_ASSUMED) + { + gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be TYPE(*)", + gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, + &a->where); + return FAILURE; + } + + if (a->ts.type == BT_PROCEDURE) + { + gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be a " + "procedure", gfc_current_intrinsic_arg[0]->name, + gfc_current_intrinsic, &a->where); + return FAILURE; + } + if (kind == NULL) return SUCCESS; diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 358c33e..2a51d10 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -2698,7 +2698,7 @@ add_functions (void) make_from_module(); add_sym_1 ("sizeof", GFC_ISYM_SIZEOF, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, ii, - GFC_STD_GNU, gfc_check_sizeof, NULL, NULL, + GFC_STD_GNU, gfc_check_sizeof, gfc_simplify_sizeof, NULL, x, BT_UNKNOWN, 0, REQUIRED); make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU); @@ -2724,7 +2724,7 @@ add_functions (void) add_sym_1 ("c_sizeof", GFC_ISYM_C_SIZEOF, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, gfc_index_integer_kind, GFC_STD_F2008, - gfc_check_c_sizeof, NULL, NULL, + gfc_check_c_sizeof, gfc_simplify_sizeof, NULL, x, BT_UNKNOWN, 0, REQUIRED); make_from_module(); @@ -2782,7 +2782,8 @@ add_functions (void) add_sym_2 ("storage_size", GFC_ISYM_STORAGE_SIZE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008, - gfc_check_storage_size, NULL, gfc_resolve_storage_size, + gfc_check_storage_size, gfc_simplify_storage_size, + gfc_resolve_storage_size, a, BT_UNKNOWN, 0, REQUIRED, kind, BT_INTEGER, di, OPTIONAL); diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index 0f9b50c..347d71d 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -376,6 +376,8 @@ gfc_expr *gfc_simplify_shiftr (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_sin (gfc_expr *); gfc_expr *gfc_simplify_sinh (gfc_expr *); gfc_expr *gfc_simplify_size (gfc_expr *, gfc_expr *, gfc_expr *); +gfc_expr *gfc_simplify_sizeof (gfc_expr *); +gfc_expr *gfc_simplify_storage_size (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_sngl (gfc_expr *); gfc_expr *gfc_simplify_spacing (gfc_expr *); gfc_expr *gfc_simplify_spread (gfc_expr *, gfc_expr *, gfc_expr *); diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi index 4a48425..8c0edc7 100644 --- a/gcc/fortran/intrinsic.texi +++ b/gcc/fortran/intrinsic.texi @@ -11492,7 +11492,7 @@ expression @code{X} occupies. GNU extension @item @emph{Class}: -Intrinsic function +Inquiry function @item @emph{Syntax}: @code{N = SIZEOF(X)} diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index dc5dad2..e24cfcf 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -27,7 +27,8 @@ along with GCC; see the file COPYING3. If not see #include "intrinsic.h" #include "target-memory.h" #include "constructor.h" -#include "version.h" /* For version_string. */ +#include "tm.h" /* For BITS_PER_UNIT. */ +#include "version.h" /* For version_string. */ gfc_expr gfc_bad_expr; @@ -5649,6 +5650,82 @@ gfc_simplify_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind) } +/* SIZEOF and C_SIZEOF return the size in bytes of an array element + multiplied by the array size. */ + +gfc_expr * +gfc_simplify_sizeof (gfc_expr *x) +{ + gfc_expr *result = NULL; + mpz_t array_size; + + if (x->ts.type == BT_CLASS || x->ts.deferred) + return NULL; + + if (x->ts.type == BT_CHARACTER + && (!x->ts.u.cl || !x->ts.u.cl->length + || x->ts.u.cl->length->expr_type != EXPR_CONSTANT)) + return NULL; + + if (x->rank && x->expr_type != EXPR_ARRAY + && gfc_array_size (x, &array_size) == FAILURE) + return NULL; + + result = gfc_get_constant_expr (BT_INTEGER, gfc_index_integer_kind, + &x->where); + mpz_set_si (result->value.integer, gfc_target_expr_size (x)); + + /* gfc_target_expr_size already takes the array size for array constructors + into account. */ + if (x->rank && x->expr_type != EXPR_ARRAY) + { + mpz_mul (result->value.integer, result->value.integer, array_size); + mpz_clear (array_size); + } + + return result; +} + + +/* STORAGE_SIZE returns the size in bits of a single array element. */ + +gfc_expr * +gfc_simplify_storage_size (gfc_expr *x, + gfc_expr *kind) +{ + gfc_expr *result = NULL; + int k; + size_t elt_size; + + if (x->ts.type == BT_CLASS || x->ts.deferred) + return NULL; + + if (x->ts.type == BT_CHARACTER + && (!x->ts.u.cl || !x->ts.u.cl->length + || x->ts.u.cl->length->expr_type != EXPR_CONSTANT)) + return NULL; + + k = get_kind (BT_INTEGER, kind, "STORAGE_SIZE", gfc_default_integer_kind); + if (k == -1) + return &gfc_bad_expr; + + if (x->expr_type == EXPR_ARRAY) + { + gfc_constructor *c = gfc_constructor_first (x->value.constructor); + elt_size = gfc_target_expr_size (c->expr); + } + else + elt_size = gfc_target_expr_size (x); + + result = gfc_get_constant_expr (BT_INTEGER, gfc_index_integer_kind, + &x->where); + mpz_set_si (result->value.integer, elt_size); + + mpz_mul_ui (result->value.integer, result->value.integer, BITS_PER_UNIT); + return result; +} + + gfc_expr * gfc_simplify_sign (gfc_expr *x, gfc_expr *y) { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 17d5889..3867796 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2013-03-27 Tobias Burnus <burnus@net-b.de> + + PR fortran/56650 + PR fortran/36437 + * gfortran.dg/sizeof_2.f90: New. + * gfortran.dg/sizeof_3.f90: New. + * gfortran.dg/sizeof_proc.f90: Update dg-error. + 2013-03-27 Richard Biener <rguenther@suse.de> PR tree-optimization/37021 diff --git a/gcc/testsuite/gfortran.dg/sizeof_2.f90 b/gcc/testsuite/gfortran.dg/sizeof_2.f90 new file mode 100644 index 0000000..5f2169b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/sizeof_2.f90 @@ -0,0 +1,24 @@ +! { dg-do compile } +! +! PR fortran/56650 +! PR fortran/36437 +! +subroutine foo(x, y) + use iso_c_binding + type(*) :: x + integer :: y(*) + integer(8) :: ii + procedure() :: proc + + ii = sizeof (x) ! { dg-error "shall not be TYPE\(.\)" } + ii = c_sizeof (x) ! { dg-error "shall not be TYPE\(.\)" } + ii = storage_size (x) ! { dg-error "shall not be TYPE\(.\)" } + + ii = sizeof (y) ! { dg-error "shall not be an assumed-size array" } + ii = c_sizeof (y) ! { dg-error "shall not be an assumed-size array" } + ii = storage_size (y) ! okay, element-size is known + + ii = sizeof (proc) ! { dg-error "shall not be a procedure" } + ii = c_sizeof (proc) ! { dg-error "Procedure unexpected as argument" } + ii = storage_size (proc) ! { dg-error "shall not be a procedure" } +end diff --git a/gcc/testsuite/gfortran.dg/sizeof_3.f90 b/gcc/testsuite/gfortran.dg/sizeof_3.f90 new file mode 100644 index 0000000..d6d1fc4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/sizeof_3.f90 @@ -0,0 +1,45 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! +! PR fortran/56650 +! PR fortran/36437 +! +module m + use iso_c_binding, only: c_sizeof, c_int + implicit none + + integer(c_int), bind(C) :: MPI_Status_C_obj + integer,parameter :: MPI_STATUS_SIZE = c_sizeof(MPI_Status_C_obj) +end module m + +module m2 + use iso_c_binding, only: c_sizeof, c_int + implicit none + + integer(c_int), bind(C) :: MPI_Status_C_obj2 + integer,parameter :: MPI_STATUS_SIZE2 & + = c_sizeof(MPI_Status_C_obj2)*8/bit_size(0) +end module m2 + +subroutine test() + use m + use m2 + integer :: m1test, m2test + m1test = MPI_STATUS_SIZE + m2test = MPI_STATUS_SIZE2 +end subroutine test + +type t + character(len=20) :: str +end type t +type(t):: x(5) +integer :: iii, jjj +iii = sizeof (x) ! 5*20 (whole size in bytes) +jjj = storage_size (x) ! 8*20 (element size in bits) +end + +! { dg-final { scan-tree-dump-times "m1test = 4;" 1 "original" } } +! { dg-final { scan-tree-dump-times "m2test = 1;" 1 "original" } } +! { dg-final { scan-tree-dump-times "iii = 100;" 1 "original" } } +! { dg-final { scan-tree-dump-times "jjj = 160;" 1 "original" } } +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/sizeof_proc.f90 b/gcc/testsuite/gfortran.dg/sizeof_proc.f90 index b4a2d73..0a63537 100644 --- a/gcc/testsuite/gfortran.dg/sizeof_proc.f90 +++ b/gcc/testsuite/gfortran.dg/sizeof_proc.f90 @@ -9,11 +9,11 @@ procedure(real) :: proc procedure(real), pointer :: pp pp => sin -print *,sizeof(proc) ! { dg-error "may not be a procedure" } -print *,sizeof(pp) ! { dg-error "may not be a procedure" } +print *,sizeof(proc) ! { dg-error "shall not be a procedure" } +print *,sizeof(pp) ! { dg-error "shall not be a procedure" } print *,sizeof(pp(0.)) -print *,sizeof(sub) ! { dg-error "may not be a procedure" } -print *,sizeof(func) ! { dg-error "may not be a procedure" } +print *,sizeof(sub) ! { dg-error "shall not be a procedure" } +print *,sizeof(func) ! { dg-error "shall not be a procedure" } print *,sizeof(func()) contains |