diff options
author | Tobias Burnus <burnus@net-b.de> | 2014-07-26 11:49:00 +0200 |
---|---|---|
committer | Tobias Burnus <burnus@gcc.gnu.org> | 2014-07-26 11:49:00 +0200 |
commit | 69c3654cc6596daad012afc093ed05b6756b0377 (patch) | |
tree | b74b389b6eb95e38ae8dfd0d215a3cb99608ffb8 /gcc/fortran/check.c | |
parent | 2da068d5c04c748a27fa0694eb00bb385bac13aa (diff) | |
download | gcc-69c3654cc6596daad012afc093ed05b6756b0377.zip gcc-69c3654cc6596daad012afc093ed05b6756b0377.tar.gz gcc-69c3654cc6596daad012afc093ed05b6756b0377.tar.bz2 |
check.c (gfc_check_sizeof): Permit for assumed type if and only if it has an array descriptor.
2014-07-26 Tobias Burnus <burnus@net-b.de>
* check.c (gfc_check_sizeof): Permit for assumed type if and
only if it has an array descriptor.
* intrinsic.c (do_ts29113_check): Permit SIZEOF.
(add_functions): SIZEOF is an Inquiry function.
* intrinsic.texi (SIZEOF): Add note that only contiguous
arrays are permitted.
* trans-expr.c (gfc_conv_intrinsic_to_class): Handle assumed
rank.
* trans-intrinsic.c (gfc_conv_intrinsic_sizeof): Handle
assumed type + array descriptor, CLASS and assumed rank.
(gfc_conv_intrinsic_storage_size): Handle class arrays.
2014-07-26 Tobias Burnus <burnus@net-b.de>
* gfortran.dg/sizeof_2.f90: Change dg-error.
* gfortran.dg/sizeof_4.f90: New.
* gfortran.dg/storage_size_1.f08: Correct expected
value.
From-SVN: r213079
Diffstat (limited to 'gcc/fortran/check.c')
-rw-r--r-- | gcc/fortran/check.c | 7 |
1 files changed, 6 insertions, 1 deletions
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index eff2c4c..95d2869 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -3902,7 +3902,12 @@ gfc_check_sizeof (gfc_expr *arg) return false; } - if (arg->ts.type == BT_ASSUMED) + /* TYPE(*) is acceptable if and only if it uses an array descriptor. */ + if (arg->ts.type == BT_ASSUMED + && (arg->symtree->n.sym->as == NULL + || (arg->symtree->n.sym->as->type != AS_ASSUMED_SHAPE + && arg->symtree->n.sym->as->type != AS_DEFERRED + && arg->symtree->n.sym->as->type != AS_ASSUMED_RANK))) { gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be TYPE(*)", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, |