PR fortran/48958 - Add runtime diagnostics for SIZE intrinsic function

Add code for runtime checking of status of ALLOCATABLE and POINTER
arguments to the SIZE intrinsic when -fcheck=pointer is specified.

gcc/fortran/ChangeLog:

	* trans-intrinsic.c (gfc_conv_intrinsic_size): Generate runtime
	checking code for status of argument.

gcc/testsuite/ChangeLog:

	* gfortran.dg/pr48958.f90: New test.

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index e0afc10d105def27698522999d13c13d58e55520..d17b623924c63cb3c04f6b86f65799cc3089e6df 100644 (file)
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -7929,6 +7929,35 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr)
       && strcmp (e->ref->u.c.component->name, "_data") == 0)
     sym = e->symtree->n.sym;
 
+  if ((gfc_option.rtcheck & GFC_RTCHECK_POINTER)
+      && e
+      && (e->expr_type == EXPR_VARIABLE || e->expr_type == EXPR_FUNCTION))
+    {
+      symbol_attribute attr;
+      char *msg;
+
+      attr = gfc_expr_attr (e);
+      if (attr.allocatable)
+       msg = xasprintf ("Allocatable argument '%s' is not allocated",
+                        e->symtree->n.sym->name);
+      else if (attr.pointer)
+       msg = xasprintf ("Pointer argument '%s' is not associated",
+                        e->symtree->n.sym->name);
+      else
+       goto end_arg_check;
+
+      argse.descriptor_only = 1;
+      gfc_conv_expr_descriptor (&argse, actual->expr);
+      tree temp = gfc_conv_descriptor_data_get (argse.expr);
+      tree cond = fold_build2_loc (input_location, EQ_EXPR,
+                                  logical_type_node, temp,
+                                  fold_convert (TREE_TYPE (temp),
+                                                null_pointer_node));
+      gfc_trans_runtime_check (true, false, cond, &argse.pre, &e->where, msg);
+      free (msg);
+    }
+ end_arg_check:
+
   argse.data_not_needed = 1;
   if (gfc_is_class_array_function (e))
     {

diff --git a/gcc/testsuite/gfortran.dg/pr48958.f90 b/gcc/testsuite/gfortran.dg/pr48958.f90
new file mode 100644 (file)
index 0000000..2b10937
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr48958.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+! { dg-options "-fcheck=pointer -fdump-tree-original" }
+! { dg-shouldfail "Fortran runtime error: Allocatable argument 'a' is not allocated" }
+! { dg-output "At line 13 .*" }
+! PR48958 - Add runtime diagnostics for SIZE intrinsic function
+
+program p
+  integer :: n
+  integer,  allocatable :: a(:)
+  integer,  pointer     :: b(:)
+  class(*), allocatable :: c(:)
+  integer               :: d(10)
+  print *, size (a)
+  print *, size (b)
+  print *, size (c)
+  print *, size (d)
+  print *, size (f(n))
+contains
+  function f (n)
+    integer, intent(in) :: n
+    real, allocatable   :: f(:)
+  end function f
+end
+
+! { dg-final { scan-tree-dump-times "_gfortran_runtime_error_at" 4 "original" } }