mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-05 16:51:13 +08:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
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.
This commit is contained in:
Harald Anlauf 2020-11-16 22:00:58 +01:00
parent a71a2255bc
commit 0c81ccc3d8
2 changed files with 54 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
gcc/fortran/trans-intrinsic.c
View File

@ -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))
{

25
gcc/testsuite/gfortran.dg/pr48958.f90 Normal file
View File

@ -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" } }