2006-04-04 H.J. Lu <hongjiu.lu@intel.com>
PR fortran/25619
* trans-array.c (gfc_conv_expr_descriptor): Only dereference
character pointer when copying temporary.
PR fortran/23634
* trans-array.c (gfc_conv_expr_descriptor): Properly copy
temporary character with non constant size.
gcc/testsuite/
2006-04-04 Paul Thomas <pault@gcc.gnu.org>
PR fortran/23634
PR fortran/25619
* gfortran.dg/actual_array_constructor_1.f90: New testcase.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@112695
138bc75d-0d04-0410-961f-
82ee72b054a4
+2006-04-04 H.J. Lu <hongjiu.lu@intel.com>
+
+ PR fortran/25619
+ * trans-array.c (gfc_conv_expr_descriptor): Only dereference
+ character pointer when copying temporary.
+
+ PR fortran/23634
+ * trans-array.c (gfc_conv_expr_descriptor): Properly copy
+ temporary character with non constant size.
+
2006-04-03 Paul Thomas <pault@gcc.gnu.org>
PR fortran/26981
loop.temp_ss->next = gfc_ss_terminator;
if (expr->ts.type == BT_CHARACTER)
{
- gcc_assert (expr->ts.cl && expr->ts.cl->length
- && expr->ts.cl->length->expr_type == EXPR_CONSTANT);
- loop.temp_ss->string_length = gfc_conv_mpz_to_tree
- (expr->ts.cl->length->value.integer,
- expr->ts.cl->length->ts.kind);
- expr->ts.cl->backend_decl = loop.temp_ss->string_length;
- }
- loop.temp_ss->data.temp.type = gfc_typenode_for_spec (&expr->ts);
-
- /* ... which can hold our string, if present. */
- if (expr->ts.type == BT_CHARACTER)
- {
- loop.temp_ss->string_length = TYPE_SIZE_UNIT (loop.temp_ss->data.temp.type);
+ if (expr->ts.cl
+ && expr->ts.cl->length
+ && expr->ts.cl->length->expr_type == EXPR_CONSTANT)
+ {
+ expr->ts.cl->backend_decl
+ = gfc_conv_mpz_to_tree (expr->ts.cl->length->value.integer,
+ expr->ts.cl->length->ts.kind);
+ loop.temp_ss->data.temp.type
+ = gfc_typenode_for_spec (&expr->ts);
+ loop.temp_ss->string_length
+ = TYPE_SIZE_UNIT (loop.temp_ss->data.temp.type);
+ }
+ else
+ {
+ loop.temp_ss->data.temp.type
+ = gfc_typenode_for_spec (&expr->ts);
+ loop.temp_ss->string_length = expr->ts.cl->backend_decl;
+ }
se->string_length = loop.temp_ss->string_length;
}
else
- loop.temp_ss->string_length = NULL;
+ {
+ loop.temp_ss->data.temp.type
+ = gfc_typenode_for_spec (&expr->ts);
+ loop.temp_ss->string_length = NULL;
+ }
loop.temp_ss->data.temp.dimen = loop.dimen;
gfc_add_ss_to_loop (&loop, loop.temp_ss);
}
if (expr->ts.type == BT_CHARACTER)
{
gfc_conv_expr (&rse, expr);
- rse.expr = build_fold_indirect_ref (rse.expr);
+ if (POINTER_TYPE_P (TREE_TYPE (rse.expr)))
+ rse.expr = build_fold_indirect_ref (rse.expr);
}
else
gfc_conv_expr_val (&rse, expr);
+2006-04-04 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/23634
+ PR fortran/25619
+ * gfortran.dg/actual_array_constructor_1.f90: New testcase.
+
2006-04-04 Eric Christopher <echristo@apple.com>
* gcc.target/i386/387-1.c: Allow regexp to match darwin
--- /dev/null
+! { dg-do run }
+! Test the fix by HJ Lu for PR23634 and friends. All involve the ICE
+! that arose from a character array constructor usedas an actual
+! argument.
+!
+! The various parts of this test are taken from the PRs.
+!
+! Test PR26491
+module global
+ public p, line
+ interface p
+ module procedure p
+ end interface
+ character(128) :: line = 'abcdefghijklmnopqrstuvwxyz'
+contains
+ subroutine p()
+ character(128) :: word
+ word = line
+ call redirect_((/word/))
+ end subroutine
+ subroutine redirect_ (ch)
+ character(*) :: ch(:)
+ if (ch(1) /= line) call abort ()
+ end subroutine redirect_
+end module global
+
+! Test PR26550
+module my_module
+ implicit none
+ type point
+ real :: x
+ end type point
+ type(point), pointer, public :: stdin => NULL()
+contains
+ subroutine my_p(w)
+ character(128) :: w
+ call r(stdin,(/w/))
+ end subroutine my_p
+ subroutine r(ptr, io)
+ use global
+ type(point), pointer :: ptr
+ character(128) :: io(:)
+ if (associated (ptr)) call abort ()
+ if (io(1) .ne. line) call abort ()
+ end subroutine r
+end module my_module
+
+program main
+ use global
+ use my_module
+
+ integer :: i(6) = (/1,6,3,4,5,2/)
+ character (6) :: a = 'hello ', t
+ character(len=1) :: s(6) = (/'g','g','d','d','a','o'/)
+ equivalence (s, t)
+
+ call option_stopwatch_s (a) ! Call test of PR25619
+ call p () ! Call test of PR26491
+ call my_p (line) ! Call test of PR26550
+
+! Test Vivek Rao's bug, as reported in PR25619.
+ s = s(i)
+ call option_stopwatch_a ((/a,'hola! ', t/))
+
+contains
+
+! Test PR23634
+ subroutine option_stopwatch_s(a)
+ character (*), intent(in) :: a
+ character (len=len(a)) :: b
+
+ b = 'hola! '
+ call option_stopwatch_a((/a, b, 'goddag'/))
+ end subroutine option_stopwatch_s
+ subroutine option_stopwatch_a (a)
+ character (*) :: a(:)
+ if (any (a .ne. (/'hello ','hola! ','goddag'/))) call abort ()
+ end subroutine option_stopwatch_a
+
+end program main
+! { dg-final { cleanup-modules "global my_module" } }
+
OSDN Git Service
