From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 20315 invoked by alias); 23 Nov 2005 14:26:20 -0000 Received: (qmail 20281 invoked by uid 48); 23 Nov 2005 14:26:16 -0000 Date: Wed, 23 Nov 2005 14:26:00 -0000 Message-ID: <20051123142616.20280.qmail@sourceware.org> X-Bugzilla-Reason: CC References: Subject: [Bug fortran/15809] ICE Using Pointer Functions In-Reply-To: Reply-To: gcc-bugzilla@gcc.gnu.org To: gcc-bugs@gcc.gnu.org From: "paul dot richard dot thomas at cea dot fr" Mailing-List: contact gcc-bugs-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Archive: List-Post: List-Help: Sender: gcc-bugs-owner@gcc.gnu.org X-SW-Source: 2005-11/txt/msg03230.txt.bz2 List-Id: ------- Comment #18 from paul dot richard dot thomas at cea dot fr 2005-11-23 14:26 ------- (In reply to comment #15) > I cannot tell why, but it seems to me that Paul Thomas' test case is no valid Hej Sven! You quite correctly picked up that it does not have an explicit interface and so will give nonsense. Making it contained or writing an interface converts my rubbish into legal code. I have made progress in converting pointer arrays into references to pointer arrays: The patch below works for pointer assignments with integers and characters and returns pointer dummy arguments correctly. There is still a problem (seg fault) with assignments of characters. This comes about because dtype does not contain the size, as is apparent from the code at the end of the message. (see the dtypes in the subroutine). There are also some issues with alignment during pointer assignments. This damn thing is going to work, legal fortran or not!!!! Both the examples below work. Paul Thomas 23rd Nov 2005 Danger: Cygwin source => whitespace issues. *** trunk/gcc/fortran/trans-array.c Wed Nov 23 14:44:18 2005 --- trunk/gcc/fortran/trans-array.c.orig Wed Nov 23 14:45:15 2005 *************** gfc_trans_deferred_array (gfc_symbol * s *** 4173,4179 **** gfc_init_block (&fnblock); ! gcc_assert (TREE_CODE (sym->backend_decl) == VAR_DECL); if (sym->ts.type == BT_CHARACTER && !INTEGER_CST_P (sym->ts.cl->backend_decl)) gfc_trans_init_string_length (sym->ts.cl, &fnblock); --- 4173,4181 ---- gfc_init_block (&fnblock); ! gcc_assert (TREE_CODE (sym->backend_decl) == VAR_DECL ! || TREE_CODE (sym->backend_decl) == PARM_DECL); ! if (sym->ts.type == BT_CHARACTER && !INTEGER_CST_P (sym->ts.cl->backend_decl)) gfc_trans_init_string_length (sym->ts.cl, &fnblock); *** trunk/gcc/fortran/trans-expr.c Wed Nov 23 14:55:20 2005 --- trunk/gcc/fortran/trans-expr.c.orig Wed Nov 23 14:56:37 2005 *************** gfc_conv_variable (gfc_se * se, gfc_expr *** 396,401 **** --- 396,404 ---- || !sym->attr.dimension)) se->expr = gfc_build_indirect_ref (se->expr); } + + if (sym->attr.pointer && sym->attr.dummy && sym->attr.dimension) + se->expr = gfc_build_indirect_ref (se->expr); ref = expr->ref; } *************** gfc_conv_function_call (gfc_se * se, gfc *** 1608,1614 **** && !formal->sym->attr.pointer && formal->sym->as->type != AS_ASSUMED_SHAPE; f = f || !sym->attr.always_explicit; ! gfc_conv_array_parameter (&parmse, arg->expr, argss, f); } } --- 1611,1619 ---- && !formal->sym->attr.pointer && formal->sym->as->type != AS_ASSUMED_SHAPE; f = f || !sym->attr.always_explicit; ! gfc_conv_array_parameter (&parmse, arg->expr, argss, f); ! if (formal != NULL && formal->sym->attr.pointer && formal->sym->attr.dimension) ! parmse.expr = gfc_build_addr_expr (NULL, parmse.expr); } } *** trunk/gcc/fortran/trans-types.c Wed Nov 23 13:48:37 2005 --- trunk/gcc/fortran/trans-types.c.orig Wed Nov 23 13:49:06 2005 *************** gfc_sym_type (gfc_symbol * sym) *** 1333,1338 **** --- 1333,1342 ---- } else type = gfc_build_array_type (type, sym->as); + + if (sym->attr.pointer && sym->attr.dummy) + type = build_reference_type (type); + } else { !============================================================================= module global CHARACTER(14), DIMENSION(2), target :: t end module global program oh_no_not_pr15908_again CHARACTER(12), DIMENSION(:), POINTER :: ptr allocate (ptr(2)) ptr = "xyz" call a (ptr, 12) IF ( .NOT. ASSOCIATED(ptr) ) THEN print *, "not associated in MAIN" else print *, "associated in MAIN ", size(ptr,1), len (ptr), ptr END IF contains SUBROUTINE A(p, l) use global CHARACTER(l), DIMENSION(:), POINTER :: p t = "abc" IF ( .NOT. ASSOCIATED(p) ) THEN p => t print *, "not associated in A ", size(p,1), len (p), p else print *, "associated in A ", size(p,1), len (p), p t = "lmn" p => t END IF END SUBROUTINE A end program oh_no_not_pr15908_again !=========================integer version========================= module global integer, DIMENSION(2), target :: t end module global integer, DIMENSION(:), POINTER :: ptr allocate (ptr(2)) ptr = 123 IF ( .NOT. ASSOCIATED(ptr) ) THEN print *, "not associated in MAIN" else print *, "associated in MAIN ", size(ptr,1), ptr END IF call a (ptr, 12) IF ( .NOT. ASSOCIATED(ptr) ) THEN print *, "not associated in MAIN" else print *, "associated in MAIN ", size(ptr,1), ptr END IF contains SUBROUTINE A(p, l) use global integer, DIMENSION(:), POINTER :: p t = 456 IF ( .NOT. ASSOCIATED(p) ) THEN p => t print *, "not associated in A ", size(p,1), p else print *, "associated in A ", size(p,1), p t = 789 p => t print *, "associated in A ", size(p,1), p END IF END SUBROUTINE A end =========================code for character version==================== a (p, l, _p) { extern char t[2][1:14]; int4 .p; .p = *l; { int4 S.0; S.0 = 1; while (1) { if (S.0 > 2) goto L.1; else (void) 0; _gfortran_copy_string (14, &t[NON_LVALUE_EXPR + -1], 3, "abc"); S.0 = S.0 + 1; } L.1:; } if ((char[0:][1:] *) (*p)->data != 0B == 0) { (*p)->dtype = 49; (*p)->dim[0].lbound = 1; (*p)->dim[0].ubound = 2; (*p)->dim[0].stride = 1; (*p)->data = (void *) (char[0:][1:14] *) &t[0]; (*p)->offset = -1; _gfortran_filename = "pr15809.f90"; _gfortran_line = 24; _gfortran_ioparm.unit = 6; _gfortran_ioparm.list_format = 1; _gfortran_st_write (); _gfortran_transfer_character ("not associated in A ", 22); { int4 D.577; D.577 = _gfortran_size1 ((struct array1_unknown *) *p, 1); _gfortran_transfer_integer (&D.577, 4); } { int4 D.578; D.578 = .p; _gfortran_transfer_integer (&D.578, 4); } _gfortran_transfer_array ((struct array1_unknown *) *p, 1, .p); _gfortran_st_write_done (); } else { _gfortran_filename = "pr15809.f90"; _gfortran_line = 26; _gfortran_ioparm.unit = 6; _gfortran_ioparm.list_format = 1; _gfortran_st_write (); _gfortran_transfer_character ("associated in A ", 22); { int4 D.579; D.579 = _gfortran_size1 ((struct array1_unknown *) *p, 1); _gfortran_transfer_integer (&D.579, 4); } { int4 D.580; D.580 = .p; _gfortran_transfer_integer (&D.580, 4); } _gfortran_transfer_array ((struct array1_unknown *) *p, 1, .p); _gfortran_st_write_done (); { int4 S.1; S.1 = 1; while (1) { if (S.1 > 2) goto L.2; else (void) 0; _gfortran_copy_string (14, &t[NON_LVALUE_EXPR + -1], 3, "lmn"; S.1 = S.1 + 1; } L.2:; } (*p)->dtype = 49; (*p)->dim[0].lbound = 1; (*p)->dim[0].ubound = 2; (*p)->dim[0].stride = 1; (*p)->data = (void *) (char[0:][1:14] *) &t[0]; (*p)->offset = -1; } } MAIN__ () { struct array1_unknown ptr; static void a (struct array1_unknown & &, int4 &, int4); ptr.data = 0B; { void * * D.584; ptr.dtype = 1585; ptr.dim[0].lbound = 1; ptr.dim[0].ubound = 2; ptr.dim[0].stride = 1; D.584 = &ptr.data; _gfortran_allocate (D.584, 48, 0); ptr.offset = -1; } { int4 D.587; int4 D.586; char[0:][1:24] * D.585; D.585 = (char[0:][1:24] *) ptr.data; D.586 = ptr.offset; D.587 = ptr.dim[0].lbound; { int4 D.589; int4 S.2; D.589 = ptr.dim[0].stride; S.2 = D.587; while (1) { if (S.2 > ptr.dim[0].ubound) goto L.3; else (void) 0; _gfortran_copy_string (24, &(*D.585)[NON_LVALUE_EXPR * D.589 + .586], 3, "xyz"); S.2 = S.2 + 1; } L.3:; } } { int4 C.591 = 12; a (&&ptr, &C.591, 24); } if ((char[0:][1:24] *) ptr.data != 0B == 0) { _gfortran_filename = "pr15809.f90"; _gfortran_line = 11; _gfortran_ioparm.unit = 6; _gfortran_ioparm.list_format = 1; _gfortran_st_write (); _gfortran_transfer_character ("not associated in MAIN", 22); _gfortran_st_write_done (); } else { _gfortran_filename = "pr15809.f90"; _gfortran_line = 13; _gfortran_ioparm.unit = 6; _gfortran_ioparm.list_format = 1; _gfortran_st_write (); _gfortran_transfer_character ("associated in MAIN ", 22); { int4 D.592; D.592 = _gfortran_size1 (&ptr, 1); _gfortran_transfer_integer (&D.592, 4); } { int4 C.593 = 24; _gfortran_transfer_integer (&C.593, 4); } _gfortran_transfer_array (&ptr, 1, 24); _gfortran_st_write_done (); } } -- http://gcc.gnu.org/bugzilla/show_bug.cgi?id=15809