View | Details | Raw Unified | Return to bug 27997 | Differences between
and this patch

Collapse All | Expand All

(-)gcc/testsuite/gfortran.dg/array_constructor_type_5.f03 (+18 lines)
Line 0 Link Here
1
! { dg-do run }
2
!
3
! PR fortran/27997
4
!
5
! Array constructor with typespec and small length value.
6
!
7
program test
8
  implicit none
9
  character(15) :: a(3)
10
  a =  (/ character(len=3) :: 'Takata', 'Tanaka', 'Hayashi' /)
11
  if(     a(1) /= 'Tak'  .or. a(1)(4:4)   /= achar(32) &
12
                         .or. a(1)(15:15) /= achar(32) &
13
     .or. a(2) /= 'Tan'  .or. a(2)(4:4)   /= achar(32) &
14
                         .or. a(2)(15:15) /= achar(32) &
15
     .or. a(3) /= 'Hay'  .or. a(3)(4:4)   /= achar(32) &
16
                         .or. a(3)(15:15) /= achar(32))&
17
   call abort()
18
end program test
(-)gcc/testsuite/gfortran.dg/array_constructor_type_6.f03 (+29 lines)
Line 0 Link Here
1
! { dg-do run }
2
!
3
! PR fortran/27997
4
!
5
! Array constructor with typespec.
6
!
7
program test
8
  character(15) :: a(3)
9
  character(10), volatile :: b(3)
10
  b(1) = 'Takata'
11
  b(2) = 'Tanaka'
12
  b(3) = 'Hayashi'
13
14
  a =  (/ character(len=7) :: trim(b(1)), trim(b(2)), trim(b(3)) /)
15
  if (a(1) /= 'Takata' .or. a(2) /= 'Tanaka' .or. a(3) /= 'Hayashi') then
16
    call abort ()
17
  end if
18
19
  a =  (/ character(len=2) :: trim(b(1)), trim(b(2)), trim(b(3)) /)
20
  if (a(1) /= 'Ta' .or. a(2) /= 'Ta' .or. a(3) /= 'Ha') then
21
    call abort ()
22
  end if
23
24
  a =  (/ character(len=8) :: trim(b(1)), trim(b(2)), trim(b(3)) /)
25
  if (a(1) /= 'Takata' .or. a(2) /= 'Tanaka' .or. a(3) /= 'Hayashi') then
26
    call abort ()
27
  end if
28
29
end program test
(-)gcc/testsuite/gfortran.dg/array_constructor_type_10.f03 (+22 lines)
Line 0 Link Here
1
! { dg-do run }
2
!
3
! PR fortran/27997
4
!
5
! Array constructor with typespec and dynamic
6
! character length.
7
!
8
PROGRAM test
9
  CALL foo(8, "short", "short")
10
  CALL foo(2, "lenghty", "le")
11
CONTAINS
12
  SUBROUTINE foo (n, s, shouldBe)
13
    CHARACTER(len=*) :: s
14
    CHARACTER(len=*) :: shouldBe
15
    CHARACTER(len=16) :: arr(2)
16
    INTEGER :: n
17
    arr = [ character(len=n) :: s, s ]
18
    IF (arr(1) /= shouldBe .OR. arr(2) /= shouldBe) THEN
19
      CALL abort ()
20
    END IF
21
  END SUBROUTINE foo
22
END PROGRAM test
(-)gcc/testsuite/gfortran.dg/array_constructor_type_7.f03 (+22 lines)
Line 0 Link Here
1
! { dg-do run }
2
!
3
! PR fortran/27997
4
!
5
! Array constructor with typespec and dynamic
6
! character length.
7
!
8
PROGRAM test
9
  CALL foo(8, "short", "test", "short")
10
  CALL foo(2, "lenghty", "te", "le")
11
CONTAINS
12
  SUBROUTINE foo (n, s, a1, a2)
13
    CHARACTER(len=*) :: s
14
    CHARACTER(len=*) :: a1, a2
15
    CHARACTER(len=n) :: arr(2)
16
    INTEGER :: n
17
    arr = [ character(len=n) :: 'test', s ]
18
    IF (arr(1) /= a1 .OR. arr(2) /= a2) THEN
19
      CALL abort ()
20
    END IF
21
  END SUBROUTINE foo
22
END PROGRAM test
(-)gcc/testsuite/gfortran.dg/array_constructor_type_11.f03 (+11 lines)
Line 0 Link Here
1
! { dg-do run }
2
!
3
! PR fortran/27997
4
!
5
! Empty array constructor with typespec.
6
!
7
 integer :: i(3)
8
 i(3:2) = (/ integer :: /)
9
 if (len((/ character(5) :: /)) /= 5) call abort()
10
 if (kind((/ integer(8) :: /)) /= 8) call abort()
11
end
(-)gcc/testsuite/gfortran.dg/array_constructor_type_8.f03 (+13 lines)
Line 0 Link Here
1
! { dg-do run }
2
!
3
! PR fortran/27997
4
!
5
! Array constructor with typespec, check for regression
6
!
7
program test
8
  implicit none
9
  type :: real_info
10
    integer :: kind
11
  end type real_info
12
  type (real_info) :: real_infos(1) = (/ real_info (4) /)
13
end program test
(-)gcc/testsuite/gfortran.dg/array_constructor_type_12.f03 (+12 lines)
Line 0 Link Here
1
! { dg-do run }
2
!
3
! PR fortran/27997
4
!
5
! Array constructor with typespec.
6
!
7
real :: a(3)
8
integer :: j(3)
9
a = (/ integer :: 1.4, 2.2, 3.33  /)
10
j = (/ 1.4, 2.2, 3.33  /)
11
if( any(a /= j )) call abort()
12
end
(-)gcc/testsuite/gfortran.dg/array_constructor_type_9.f (+10 lines)
Line 0 Link Here
1
! { dg-do run }
2
!
3
! PR fortran/27997
4
!
5
! Array constructor with typespec, check for regression
6
! with fixed form.
7
!
8
      integer :: a(2), realabc, real_abc2
9
      a = [ realabc, real_abc2 ]
10
      end
(-)gcc/testsuite/gfortran.dg/array_constructor_type_1.f03 (+17 lines)
Line 0 Link Here
1
! { dg-do run }
2
!
3
! PR fortran/27997
4
!
5
! Simple array constructor with typespec.
6
!
7
PROGRAM test
8
  IMPLICIT NONE
9
  INTEGER :: array(5)
10
11
  array = (/ INTEGER :: 18, 12, 31, 3, 42.4 /)
12
13
  IF (array(1) /= 18 .OR. array(2) /= 12 .OR. &
14
      array(3) /= 31 .OR. array(4) /=  3 .OR. array(5) /= 42) THEN
15
      CALL abort()
16
  END IF
17
END PROGRAM test
(-)gcc/testsuite/gfortran.dg/array_constructor_type_2.f03 (+20 lines)
Line 0 Link Here
1
! { dg-do run }
2
!
3
! PR fortran/27997
4
!
5
! Array constructor with typespec, length parameter.
6
!
7
program test
8
  implicit none
9
  character(15) :: a(3)
10
  a =  (/ character(len=7) :: 'Takata', 'Tanaka', 'Hayashi' /)
11
  if ( len([ character(len=7) :: ]) /= 7) call abort()
12
  if ( size([ integer :: ]) /= 0) call abort()
13
  if(     a(1) /= 'Takata'  .or. a(1)(7:7)   /= achar(32) &
14
                            .or. a(1)(15:15) /= achar(32) &
15
     .or. a(2) /= 'Tanaka'  .or. a(2)(7:7)   /= achar(32) &
16
                            .or. a(2)(15:15) /= achar(32) &
17
     .or. a(3) /= 'Hayashi' .or. a(3)(8:8)   /= achar(32) &
18
                            .or. a(3)(15:15) /= achar(32))&
19
   call abort()
20
end program test
(-)gcc/testsuite/gfortran.dg/array_constructor_type_3.f03 (+16 lines)
Line 0 Link Here
1
! { dg-do run }
2
!
3
! PR fortran/27997
4
!
5
! Test empty array constructor with typespec.
6
!
7
PROGRAM test
8
  IMPLICIT NONE
9
  INTEGER :: array(2)
10
11
  array = (/ 5, [INTEGER ::], 6 /)
12
13
  IF (array(1) /= 5 .OR. array(2) /= 6) THEN
14
      CALL abort()
15
  END IF
16
END PROGRAM test
(-)gcc/testsuite/gfortran.dg/array_constructor_type_4.f03 (+15 lines)
Line 0 Link Here
1
! { dg-do run }
2
!
3
! PR fortran/27997
4
!
5
! Ensure that :: is present when a typespec is deduced.
6
!
7
PROGRAM test
8
  INTEGER :: array(1)
9
  INTEGER = 42
10
11
  array = [ INTEGER ]
12
  IF (array(1) /= 42) THEN
13
    CALL abort()
14
  END IF
15
END PROGRAM test
(-)gcc/fortran/trans-array.c (-1 / +15 lines)
Lines 1692-1699 Link Here
1692
  c = ss->expr->value.constructor;
1692
  c = ss->expr->value.constructor;
1693
  if (ss->expr->ts.type == BT_CHARACTER)
1693
  if (ss->expr->ts.type == BT_CHARACTER)
1694
    {
1694
    {
1695
      bool const_string = get_array_ctor_strlen (&loop->pre, c, &ss->string_length);
1695
      bool const_string;
1696
      
1697
      if (ss->expr->ts.cl->length
1698
          && ss->expr->ts.cl->length->expr_type != EXPR_CONSTANT)
1699
        {
1700
          gfc_se length_se;
1696
1701
1702
          const_string = false;
1703
          gfc_init_se (&length_se, NULL);
1704
          gfc_conv_expr (&length_se, ss->expr->ts.cl->length);
1705
          ss->string_length = length_se.expr;
1706
        }
1707
      else
1708
        const_string = get_array_ctor_strlen (&loop->pre, c,
1709
                                              &ss->string_length);
1710
1697
      /* Complex character array constructors should have been taken care of
1711
      /* Complex character array constructors should have been taken care of
1698
	 and not end up here.  */
1712
	 and not end up here.  */
1699
      gcc_assert (ss->string_length);
1713
      gcc_assert (ss->string_length);
(-)gcc/fortran/array.c (-14 / +77 lines)
Lines 877-885 Link Here
877
{
877
{
878
  gfc_constructor *head, *tail, *new;
878
  gfc_constructor *head, *tail, *new;
879
  gfc_expr *expr;
879
  gfc_expr *expr;
880
  gfc_typespec ts;
880
  locus where;
881
  locus where;
881
  match m;
882
  match m;
882
  const char *end_delim;
883
  const char *end_delim;
884
  bool seen_ts;
883
885
884
  if (gfc_match (" (/") == MATCH_NO)
886
  if (gfc_match (" (/") == MATCH_NO)
885
    {
887
    {
Lines 898-908 Link Here
898
900
899
  where = gfc_current_locus;
901
  where = gfc_current_locus;
900
  head = tail = NULL;
902
  head = tail = NULL;
903
  seen_ts = false;
901
904
905
  /* Try to match an optional "type-spec ::"  */
906
  if (gfc_match_type_spec (&ts, 0) == MATCH_YES)
907
    {
908
      seen_ts = (gfc_match (" ::") == MATCH_YES);
909
910
      if (seen_ts)
911
        {
912
          if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Array constructor "
913
                              "including type specification at %C") == FAILURE)
914
            goto cleanup;
915
        }
916
    }
917
918
  if (! seen_ts)
919
    gfc_current_locus = where;
920
902
  if (gfc_match (end_delim) == MATCH_YES)
921
  if (gfc_match (end_delim) == MATCH_YES)
903
    {
922
    {
904
      gfc_error ("Empty array constructor at %C is not allowed");
923
      if (seen_ts)
905
      goto cleanup;
924
	goto done;
925
      else
926
	{
927
	  gfc_error ("Empty array constructor at %C is not allowed");
928
	  goto cleanup;
929
	}
906
    }
930
    }
907
931
908
  for (;;)
932
  for (;;)
Lines 927-932 Link Here
927
  if (gfc_match (end_delim) == MATCH_NO)
951
  if (gfc_match (end_delim) == MATCH_NO)
928
    goto syntax;
952
    goto syntax;
929
953
954
done:
930
  expr = gfc_get_expr ();
955
  expr = gfc_get_expr ();
931
956
932
  expr->expr_type = EXPR_ARRAY;
957
  expr->expr_type = EXPR_ARRAY;
Lines 934-939 Link Here
934
  expr->value.constructor = head;
959
  expr->value.constructor = head;
935
  /* Size must be calculated at resolution time.  */
960
  /* Size must be calculated at resolution time.  */
936
961
962
  if (seen_ts)
963
    expr->ts = ts;
964
  else
965
    expr->ts.type = BT_UNKNOWN;
966
937
  expr->where = where;
967
  expr->where = where;
938
  expr->rank = 1;
968
  expr->rank = 1;
939
969
Lines 964-970 Link Here
964
cons_state;
994
cons_state;
965
995
966
static int
996
static int
967
check_element_type (gfc_expr *expr)
997
check_element_type (gfc_expr *expr, bool convert)
968
{
998
{
969
  if (cons_state == CONS_BAD)
999
  if (cons_state == CONS_BAD)
970
    return 0;			/* Suppress further errors */
1000
    return 0;			/* Suppress further errors */
Lines 985-990 Link Here
985
  if (gfc_compare_types (&constructor_ts, &expr->ts))
1015
  if (gfc_compare_types (&constructor_ts, &expr->ts))
986
    return 0;
1016
    return 0;
987
1017
1018
  if (convert)
1019
    return gfc_convert_type (expr, &constructor_ts, 1) == SUCCESS ? 0 : 1;
1020
988
  gfc_error ("Element in %s array constructor at %L is %s",
1021
  gfc_error ("Element in %s array constructor at %L is %s",
989
	     gfc_typename (&constructor_ts), &expr->where,
1022
	     gfc_typename (&constructor_ts), &expr->where,
990
	     gfc_typename (&expr->ts));
1023
	     gfc_typename (&expr->ts));
Lines 997-1003 Link Here
997
/* Recursive work function for gfc_check_constructor_type().  */
1030
/* Recursive work function for gfc_check_constructor_type().  */
998
1031
999
static try
1032
static try
1000
check_constructor_type (gfc_constructor *c)
1033
check_constructor_type (gfc_constructor *c, bool convert)
1001
{
1034
{
1002
  gfc_expr *e;
1035
  gfc_expr *e;
1003
1036
Lines 1007-1019 Link Here
1007
1040
1008
      if (e->expr_type == EXPR_ARRAY)
1041
      if (e->expr_type == EXPR_ARRAY)
1009
	{
1042
	{
1010
	  if (check_constructor_type (e->value.constructor) == FAILURE)
1043
	  if (check_constructor_type (e->value.constructor, convert) == FAILURE)
1011
	    return FAILURE;
1044
	    return FAILURE;
1012
1045
1013
	  continue;
1046
	  continue;
1014
	}
1047
	}
1015
1048
1016
      if (check_element_type (e))
1049
      if (check_element_type (e, convert))
1017
	return FAILURE;
1050
	return FAILURE;
1018
    }
1051
    }
1019
1052
Lines 1029-1038 Link Here
1029
{
1062
{
1030
  try t;
1063
  try t;
1031
1064
1032
  cons_state = CONS_START;
1065
  if (e->ts.type != BT_UNKNOWN)
1033
  gfc_clear_ts (&constructor_ts);
1066
    {
1067
      cons_state = CONS_GOOD;
1068
      constructor_ts = e->ts;
1069
    }
1070
  else
1071
    {
1072
      cons_state = CONS_START;
1073
      gfc_clear_ts (&constructor_ts);
1074
    }
1034
1075
1035
  t = check_constructor_type (e->value.constructor);
1076
  /* If e->ts.type != BT_UNKNOWN, the array constructor included a
1077
     typespec, and we will now convert the values on the fly.  */
1078
  t = check_constructor_type (e->value.constructor, e->ts.type != BT_UNKNOWN);
1036
  if (t == SUCCESS && e->ts.type == BT_UNKNOWN)
1079
  if (t == SUCCESS && e->ts.type == BT_UNKNOWN)
1037
    e->ts = constructor_ts;
1080
    e->ts = constructor_ts;
1038
1081
Lines 1526-1532 Link Here
1526
1569
1527
/* Resolve character array constructor. If it is a constant character array and
1570
/* Resolve character array constructor. If it is a constant character array and
1528
   not specified character length, update character length to the maximum of
1571
   not specified character length, update character length to the maximum of
1529
   its element constructors' length.  */
1572
   its element constructors' length.  For arrays with fixed length, pad the
1573
   elements as necessary with needed_length.  */
1530
1574
1531
void
1575
void
1532
gfc_resolve_character_array_constructor (gfc_expr *expr)
1576
gfc_resolve_character_array_constructor (gfc_expr *expr)
Lines 1596-1607 Link Here
1596
	{
1640
	{
1597
	  /* Update the character length of the array constructor.  */
1641
	  /* Update the character length of the array constructor.  */
1598
	  expr->ts.cl->length = gfc_int_expr (max_length);
1642
	  expr->ts.cl->length = gfc_int_expr (max_length);
1599
	  /* Update the element constructors.  */
1600
	  for (p = expr->value.constructor; p; p = p->next)
1601
	    if (p->expr->expr_type == EXPR_CONSTANT)
1602
	      gfc_set_constant_character_len (max_length, p->expr, true);
1603
	}
1643
	}
1604
    }
1644
    }
1645
  else 
1646
    {
1647
      /* We've got a character length specified.  It should be an integer,
1648
         otherwise an error is signalled elsewhere.  */
1649
      gcc_assert (expr->ts.cl->length);
1650
      if (expr->ts.cl->length->ts.type == BT_INTEGER)
1651
        {
1652
          if (expr->ts.cl->length->expr_type == EXPR_CONSTANT)
1653
            {
1654
              /* Got a constant character length, pad according to this.  */
1655
              max_length = mpz_get_si (expr->ts.cl->length->value.integer);
1656
            }
1657
        }
1658
    }
1659
1660
  /* Found a length to update to, do it.  */
1661
  if (max_length != -1)
1662
    {
1663
      /* Update the element constructors.  */
1664
      for (p = expr->value.constructor; p; p = p->next)
1665
        if (p->expr->expr_type == EXPR_CONSTANT)
1666
          gfc_set_constant_character_len (max_length, p->expr, true);
1667
    }
1605
}
1668
}
1606
1669
1607
1670

Return to bug 27997