aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/check.c
diff options
context:
space:
mode:
authorTobias Burnus <burnus@net-b.de>2014-07-26 11:49:00 +0200
committerTobias Burnus <burnus@gcc.gnu.org>2014-07-26 11:49:00 +0200
commit69c3654cc6596daad012afc093ed05b6756b0377 (patch)
treeb74b389b6eb95e38ae8dfd0d215a3cb99608ffb8 /gcc/fortran/check.c
parent2da068d5c04c748a27fa0694eb00bb385bac13aa (diff)
downloadgcc-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.c7
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,