re PR fortran/56650 (Odd error messages with C_SIZEOF for valid code)

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

From-SVN: r197159

gcc/fortran/ChangeLog

+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

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;
 

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

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 *);

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)}

gcc/fortran/simplify.c

@@ -27,6 +27,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "intrinsic.h"
 #include "target-memory.h"
 #include "constructor.h"
+#include "tm.h"		/* For BITS_PER_UNIT.  */
 #include "version.h"	/* For version_string.  */
 
 
@@ -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)
 {

gcc/testsuite/ChangeLog

+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

gcc/testsuite/gfortran.dg/sizeof_2.f90

+! { 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

gcc/testsuite/gfortran.dg/sizeof_3.f90

+! { 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" } }

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