procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

expr.c (gfc_check_assign): Add comment.

Browse source 
fortran/
* expr.c (gfc_check_assign): Add comment. Add new warning.
* trans-expr.c (gfc_conv_function_call): Correctly dereference
 result of pointer valued function when not in pointer assignment.

testsuite/
* gfortran.dg/assignment_1.f90: New test.

From-SVN: r86585
This commit is contained in:
Tobias Schlüter 2004-08-26 00:07:32 +02:00 • committed by Tobias Schlüter
parent 4c124b4c6f
commit 6d1c50cce4
5 changed files with 62 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View file

@ -1,3 +1,9 @@
2004-08-25 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
* expr.c (gfc_check_assign): Add comment. Add new warning.
* trans-expr.c (gfc_conv_function_call): Correctly dereference
result of pointer valued function when not in pointer assignment.
2004-08-25 Paul Brook <paul@codesourcery.com>
* config-lang.in: Remove dead commented line.

9
gcc/fortran/expr.c
View file

@ -1797,10 +1797,19 @@ gfc_check_assign (gfc_expr * lvalue, gfc_expr * rvalue, int conform)
return FAILURE;
}
/* This is a guaranteed segfault and possibly a typo: p = NULL()
instead of p => NULL() */
if (rvalue->expr_type == EXPR_NULL)
gfc_warning ("NULL appears on right-hand side in assignment at %L",
&rvalue->where);
/* This is possibly a typo: x = f() instead of x => f() */
if (gfc_option.warn_surprising
&& rvalue->expr_type == EXPR_FUNCTION
&& rvalue->symtree->n.sym->attr.pointer)
gfc_warning ("POINTER valued function appears on right-hand side of "
"assignment at %L", &rvalue->where);
/* Check size of array assignments. */
if (lvalue->rank != 0 && rvalue->rank != 0
&& gfc_check_conformance ("Array assignment", lvalue, rvalue) != SUCCESS)

7
gcc/fortran/trans-expr.c
View file

@ -1170,6 +1170,13 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
se->expr = build3 (CALL_EXPR, TREE_TYPE (fntype), se->expr,
arglist, NULL_TREE);
/* If we have a pointer function, but we don't want a pointer, e.g.
something like
x = f()
where f is pointer valued, we have to dereference the result. */
if (sym->attr.pointer && !se->want_pointer && !byref)
se->expr = gfc_build_indirect_ref (se->expr);
/* A pure function may still have side-effects - it may modify its
parameters. */
TREE_SIDE_EFFECTS (se->expr) = 1;

4
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,7 @@
2004-08-25 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
* gfortran.dg/assignment_1.f90: New test.
2004-08-25 Adam Nemet <anemet@lnxw.com>
* g++.dg/template/repo3.C: New test.

36
gcc/testsuite/gfortran.dg/assignment_1.f90 Normal file
View file

@ -0,0 +1,36 @@
! { dg-do run }
! { dg-options -Wsurprising }
integer, pointer :: p
integer, target :: t, s
! The tests for character pointers are currently commented out,
! because they don't yet work correctly.
! This is PR 17192
!!$character*5, pointer :: d
!!$character*5, target :: c, e
t = 1
p => s
! We didn't dereference the pointer in the following line.
p = f() ! { dg-warning "POINTER valued function" "" }
p = p+1
if (p.ne.2) call abort()
if (p.ne.s) call abort()
!!$! verify that we also dereference correctly the result of a function
!!$! which returns its result by reference
!!$c = "Hallo"
!!$d => e
!!$d = g() ! dg-warning "POINTER valued function" ""
!!$if (d.ne."Hallo") call abort()
contains
function f()
integer, pointer :: f
f => t
end function f
!!$function g()
!!$character, pointer :: g
!!$g => c
!!$end function g
end