[multiple changes]

2005-07-14  Steven G. Kargl  <kargls@comcast.net>

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

2005-07-14  Feng Wang  <fengwang@nudt.edu.cn>
	Steven G. Kargl  <kargls@comcast.net>

	* array.c (resolve_character_array_constructor): Allocate gfc_charlen
	for the array and attach to namespace list for automatic deallocation.

From-SVN: r102002
This commit is contained in:
Feng Wang 2005-07-14 01:37:41 +00:00
parent 0063a8238d
commit 4a90ae54a0
4 changed files with 33 additions and 3 deletions

View File

@ -1,3 +1,9 @@
2005-07-14 Feng Wang <fengwang@nudt.edu.cn>
Steven G. Kargl <kargls@comcast.net>
* array.c (resolve_character_array_constructor): Allocate gfc_charlen
for the array and attach to namespace list for automatic deallocation.
2005-07-13 Andreas Schwab <schwab@suse.de>
* Make-lang.in (fortran/dependency.o): Depend on

View File

@ -1529,7 +1529,14 @@ resolve_character_array_constructor (gfc_expr * expr)
max_length = -1;
if (expr->ts.cl == NULL || expr->ts.cl->length == NULL)
if (expr->ts.cl == NULL)
{
expr->ts.cl = gfc_get_charlen ();
expr->ts.cl->next = gfc_current_ns->cl_list;
gfc_current_ns->cl_list = expr->ts.cl;
}
if (expr->ts.cl->length == NULL)
{
/* Find the maximum length of the elements. Do nothing for variable array
constructor. */
@ -1542,8 +1549,6 @@ resolve_character_array_constructor (gfc_expr * expr)
if (max_length != -1)
{
/* Update the character length of the array constructor. */
if (expr->ts.cl == NULL)
expr->ts.cl = gfc_get_charlen ();
expr->ts.cl->length = gfc_int_expr (max_length);
/* Update the element constructors. */
for (p = expr->value.constructor; p; p = p->next)

View File

@ -1,3 +1,7 @@
2005-07-14 Steven G. Kargl <kargls@comcast.net>
* gfortran.dg/char_array_constructor.f90: New test.
2005-07-13 Paul Thomas <pault@gcc.gnu.org>
* gfortran.dg/past_eor.f90: New.

View File

@ -0,0 +1,15 @@
! { dg-do run }
module z
integer :: i
character(6) :: a(2) = (/ ('main ' , i = 1, 2) /)
character(6) :: b(2) = (/ 'abcd ' , 'efghij' /)
end module
program y
use z
if (a(1) /= 'main ') call abort
if (a(2) /= 'main ') call abort
if (b(1) /= 'abcd ') call abort
if (b(2) /= 'efghij') call abort
end program y