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

Collapse All | Expand All

(-)gcc/fortran/trans-array.c (-4 / +33 lines)
Lines 960-968 Link Here
960
}
960
}
961
961
962
962
963
/* Assign an element of an array constructor.  */
963
/* Variables needed for bounds-checking.  */
964
/* XXX: Ok as global or does bounds-checking need to be reentrant for things
965
   like nested constructors?  */
964
static bool first_len;
966
static bool first_len;
965
static tree first_len_val; 
967
static tree first_len_val; 
968
static bool typespec_ctor;
966
969
967
static void
970
static void
968
gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc,
971
gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc,
Lines 999-1005 Link Here
999
				 se->string_length,
1002
				 se->string_length,
1000
				 se->expr);
1003
				 se->expr);
1001
	}
1004
	}
1002
      if (flag_bounds_check)
1005
      if (flag_bounds_check && !typespec_ctor)
1003
	{
1006
	{
1004
	  if (first_len)
1007
	  if (first_len)
1005
	    {
1008
	    {
Lines 1681-1687 Link Here
1681
  tree type;
1684
  tree type;
1682
  bool dynamic;
1685
  bool dynamic;
1683
1686
1684
  if (flag_bounds_check && ss->expr->ts.type == BT_CHARACTER)
1687
  /* Do bounds-checking here and in gfc_trans_array_ctor_element only if no
1688
     typespec was given for the array constructor.  */
1689
  typespec_ctor = (ss->expr->ts.cl && ss->expr->ts.cl->length_from_typespec);
1690
1691
  if (flag_bounds_check && ss->expr->ts.type == BT_CHARACTER && !typespec_ctor)
1685
    {  
1692
    {  
1686
      first_len_val = gfc_create_var (gfc_charlen_type_node, "len");
1693
      first_len_val = gfc_create_var (gfc_charlen_type_node, "len");
1687
      first_len = true;
1694
      first_len = true;
Lines 1692-1699 Link Here
1692
  c = ss->expr->value.constructor;
1699
  c = ss->expr->value.constructor;
1693
  if (ss->expr->ts.type == BT_CHARACTER)
1700
  if (ss->expr->ts.type == BT_CHARACTER)
1694
    {
1701
    {
1695
      bool const_string = get_array_ctor_strlen (&loop->pre, c, &ss->string_length);
1702
      bool const_string;
1703
      
1704
      /* get_array_ctor_strlen walks the elements of the constructor, if a
1705
	 typespec was given, we already know the string length and want the one
1706
	 specified there.  */
1707
      /* XXX:  Adding typespec_ctor here was merely a hack to make
1708
	 gfortran.dg/array_constructor_17.f90 work (ICE otherwise).  Is this
1709
	 ok anyway or should I look for another solution?  */
1710
      if (typespec_ctor && ss->expr->ts.cl->length
1711
	  && ss->expr->ts.cl->length->expr_type != EXPR_CONSTANT)
1712
	{
1713
	  gfc_se length_se;
1696
1714
1715
	  const_string = false;
1716
	  /* XXX:  This works for my tests, but is this the correct way to
1717
	     transform the gfc_expr into a tree?  */
1718
	  gfc_init_se (&length_se, NULL);
1719
	  gfc_conv_expr (&length_se, ss->expr->ts.cl->length);
1720
	  ss->string_length = length_se.expr;
1721
	}
1722
      else
1723
	const_string = get_array_ctor_strlen (&loop->pre, c,
1724
					      &ss->string_length);
1725
1697
      /* Complex character array constructors should have been taken care of
1726
      /* Complex character array constructors should have been taken care of
1698
	 and not end up here.  */
1727
	 and not end up here.  */
1699
      gcc_assert (ss->string_length);
1728
      gcc_assert (ss->string_length);
(-)gcc/fortran/array.c (-14 / +95 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
  
967
  if (expr->ts.cl)
968
    expr->ts.cl->length_from_typespec = seen_ts;
969
937
  expr->where = where;
970
  expr->where = where;
938
  expr->rank = 1;
971
  expr->rank = 1;
939
972
Lines 964-970 Link Here
964
cons_state;
997
cons_state;
965
998
966
static int
999
static int
967
check_element_type (gfc_expr *expr)
1000
check_element_type (gfc_expr *expr, bool convert)
968
{
1001
{
969
  if (cons_state == CONS_BAD)
1002
  if (cons_state == CONS_BAD)
970
    return 0;                        /* Suppress further errors */
1003
    return 0;                        /* Suppress further errors */
Lines 985-990 Link Here
985
  if (gfc_compare_types (&constructor_ts, &expr->ts))
1018
  if (gfc_compare_types (&constructor_ts, &expr->ts))
986
    return 0;
1019
    return 0;
987
1020
1021
  if (convert)
1022
    return gfc_convert_type (expr, &constructor_ts, 1) == SUCCESS ? 0 : 1;
1023
988
  gfc_error ("Element in %s array constructor at %L is %s",
1024
  gfc_error ("Element in %s array constructor at %L is %s",
989
	     gfc_typename (&constructor_ts), &expr->where,
1025
	     gfc_typename (&constructor_ts), &expr->where,
990
	     gfc_typename (&expr->ts));
1026
	     gfc_typename (&expr->ts));
Lines 997-1003 Link Here
997
/* Recursive work function for gfc_check_constructor_type().  */
1033
/* Recursive work function for gfc_check_constructor_type().  */
998
1034
999
static try
1035
static try
1000
check_constructor_type (gfc_constructor *c)
1036
check_constructor_type (gfc_constructor *c, bool convert)
1001
{
1037
{
1002
  gfc_expr *e;
1038
  gfc_expr *e;
1003
1039
Lines 1007-1019 Link Here
1007
1043
1008
      if (e->expr_type == EXPR_ARRAY)
1044
      if (e->expr_type == EXPR_ARRAY)
1009
	{
1045
	{
1010
	  if (check_constructor_type (e->value.constructor) == FAILURE)
1046
	  if (check_constructor_type (e->value.constructor, convert) == FAILURE)
1011
	    return FAILURE;
1047
	    return FAILURE;
1012
1048
1013
	  continue;
1049
	  continue;
1014
	}
1050
	}
1015
1051
1016
      if (check_element_type (e))
1052
      if (check_element_type (e, convert))
1017
	return FAILURE;
1053
	return FAILURE;
1018
    }
1054
    }
1019
1055
Lines 1029-1038 Link Here
1029
{
1065
{
1030
  try t;
1066
  try t;
1031
1067
1032
  cons_state = CONS_START;
1068
  if (e->ts.type != BT_UNKNOWN)
1033
  gfc_clear_ts (&constructor_ts);
1069
    {
1070
      cons_state = CONS_GOOD;
1071
      constructor_ts = e->ts;
1072
    }
1073
  else
1074
    {
1075
      cons_state = CONS_START;
1076
      gfc_clear_ts (&constructor_ts);
1077
    }
1034
1078
1035
  t = check_constructor_type (e->value.constructor);
1079
  /* If e->ts.type != BT_UNKNOWN, the array constructor included a
1080
     typespec, and we will now convert the values on the fly.  */
1081
  t = check_constructor_type (e->value.constructor, e->ts.type != BT_UNKNOWN);
1036
  if (t == SUCCESS && e->ts.type == BT_UNKNOWN)
1082
  if (t == SUCCESS && e->ts.type == BT_UNKNOWN)
1037
    e->ts = constructor_ts;
1083
    e->ts = constructor_ts;
1038
1084
Lines 1526-1538 Link Here
1526
1572
1527
/* Resolve character array constructor. If it is a constant character array and
1573
/* Resolve character array constructor. If it is a constant character array and
1528
   not specified character length, update character length to the maximum of
1574
   not specified character length, update character length to the maximum of
1529
   its element constructors' length.  */
1575
   its element constructors' length.  For arrays with fixed length, pad the
1576
   elements as necessary with needed_length.  */
1530
1577
1531
void
1578
void
1532
gfc_resolve_character_array_constructor (gfc_expr *expr)
1579
gfc_resolve_character_array_constructor (gfc_expr *expr)
1533
{
1580
{
1534
  gfc_constructor *p;
1581
  gfc_constructor *p;
1535
  int max_length;
1582
  int max_length;
1583
  bool generated_length;
1536
1584
1537
  gcc_assert (expr->expr_type == EXPR_ARRAY);
1585
  gcc_assert (expr->expr_type == EXPR_ARRAY);
1538
  gcc_assert (expr->ts.type == BT_CHARACTER);
1586
  gcc_assert (expr->ts.type == BT_CHARACTER);
Lines 1557-1562 Link Here
1557
1605
1558
got_charlen:
1606
got_charlen:
1559
1607
1608
  generated_length = false;
1560
  if (expr->ts.cl->length == NULL)
1609
  if (expr->ts.cl->length == NULL)
1561
    {
1610
    {
1562
      /* Find the maximum length of the elements. Do nothing for variable
1611
      /* Find the maximum length of the elements. Do nothing for variable
Lines 1596-1607 Link Here
1596
	{
1645
	{
1597
	  /* Update the character length of the array constructor.  */
1646
	  /* Update the character length of the array constructor.  */
1598
	  expr->ts.cl->length = gfc_int_expr (max_length);
1647
	  expr->ts.cl->length = gfc_int_expr (max_length);
1599
	  /* Update the element constructors.  */
1648
	  generated_length = true;
1600
	  for (p = expr->value.constructor; p; p = p->next)
1649
	  /* Real update follows below.  */
1601
	    if (p->expr->expr_type == EXPR_CONSTANT)
1602
	      gfc_set_constant_character_len (max_length, p->expr, true);
1603
	}
1650
	}
1604
    }
1651
    }
1652
  else 
1653
    {
1654
      /* We've got a character length specified.  It should be an integer,
1655
	 otherwise an error is signalled elsewhere.  */
1656
      gcc_assert (expr->ts.cl->length);
1657
      if (expr->ts.cl->length->ts.type == BT_INTEGER)
1658
	{
1659
	  if (expr->ts.cl->length->expr_type == EXPR_CONSTANT)
1660
	    {
1661
	      /* Got a constant character length, pad according to this.  */
1662
	      max_length = mpz_get_si (expr->ts.cl->length->value.integer);
1663
	    }
1664
	}
1665
    }
1666
1667
  /* Found a length to update to, do it for all element strings shorter than
1668
     the target length.  */
1669
  if (max_length != -1)
1670
    {
1671
      for (p = expr->value.constructor; p; p = p->next)
1672
	if (p->expr->expr_type == EXPR_CONSTANT)
1673
	  {
1674
	    const gfc_expr *cl = NULL;
1675
	    if (p->expr->ts.cl && p->expr->ts.cl->length)
1676
	      cl = p->expr->ts.cl->length;
1677
	    if (generated_length || ! cl
1678
		|| (cl->expr_type == EXPR_CONSTANT
1679
		    && cl->ts.type == BT_INTEGER
1680
		    && mpz_get_si (cl->value.integer) < max_length))
1681
	      {
1682
		gfc_set_constant_character_len (max_length, p->expr, true);
1683
	      }
1684
	  }
1685
    }
1605
}
1686
}
1606
1687
1607
1688
(-)gcc/fortran/gfortran.h (+1 lines)
Lines 762-767 Link Here
762
{
762
{
763
  struct gfc_expr *length;
763
  struct gfc_expr *length;
764
  struct gfc_charlen *next;
764
  struct gfc_charlen *next;
765
  bool length_from_typespec; /* Length from explicit array ctor typespec?  */
765
  tree backend_decl;
766
  tree backend_decl;
766
767
767
  int resolved;
768
  int resolved;
(-)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 (+30 lines)
Line 0 Link Here
1
! { dg-do run }
2
! { dg-options "-fbounds-check" }
3
!
4
! PR fortran/27997
5
!
6
! Array constructor with typespec.
7
!
8
program test
9
  character(15) :: a(3)
10
  character(10), volatile :: b(3)
11
  b(1) = 'Takata'
12
  b(2) = 'Tanaka'
13
  b(3) = 'Hayashi'
14
15
  a =  (/ character(len=7) :: trim(b(1)), trim(b(2)), trim(b(3)) /)
16
  if (a(1) /= 'Takata' .or. a(2) /= 'Tanaka' .or. a(3) /= 'Hayashi') then
17
    call abort ()
18
  end if
19
20
  a =  (/ character(len=2) :: trim(b(1)), trim(b(2)), trim(b(3)) /)
21
  if (a(1) /= 'Ta' .or. a(2) /= 'Ta' .or. a(3) /= 'Ha') then
22
    call abort ()
23
  end if
24
25
  a =  (/ character(len=8) :: trim(b(1)), trim(b(2)), trim(b(3)) /)
26
  if (a(1) /= 'Takata' .or. a(2) /= 'Tanaka' .or. a(3) /= 'Hayashi') then
27
    call abort ()
28
  end if
29
30
end program test
(-)gcc/testsuite/gfortran.dg/array_constructor_type_10.f03 (+23 lines)
Line 0 Link Here
1
! { dg-do run }
2
! { dg-options "-fbounds-check" }
3
!
4
! PR fortran/27997
5
!
6
! Array constructor with typespec and dynamic
7
! character length.
8
!
9
PROGRAM test
10
  CALL foo(8, "short", "short")
11
  CALL foo(2, "lenghty", "le")
12
CONTAINS
13
  SUBROUTINE foo (n, s, shouldBe)
14
    CHARACTER(len=*) :: s
15
    CHARACTER(len=*) :: shouldBe
16
    CHARACTER(len=16) :: arr(2)
17
    INTEGER :: n
18
    arr = [ character(len=n) :: s, s ]
19
    IF (arr(1) /= shouldBe .OR. arr(2) /= shouldBe) THEN
20
      CALL abort ()
21
    END IF
22
  END SUBROUTINE foo
23
END PROGRAM test
(-)gcc/testsuite/gfortran.dg/array_constructor_type_7.f03 (+23 lines)
Line 0 Link Here
1
! { dg-do run }
2
! { dg-options "-fbounds-check" }
3
!
4
! PR fortran/27997
5
!
6
! Array constructor with typespec and dynamic
7
! character length.
8
!
9
PROGRAM test
10
  CALL foo(8, "short", "test", "short")
11
  CALL foo(2, "lenghty", "te", "le")
12
CONTAINS
13
  SUBROUTINE foo (n, s, a1, a2)
14
    CHARACTER(len=*) :: s
15
    CHARACTER(len=*) :: a1, a2
16
    CHARACTER(len=n) :: arr(2)
17
    INTEGER :: n
18
    arr = [ character(len=n) :: 'test', s ]
19
    IF (arr(1) /= a1 .OR. arr(2) /= a2) THEN
20
      CALL abort ()
21
    END IF
22
  END SUBROUTINE foo
23
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_13.f90 (+14 lines)
Line 0 Link Here
1
! { dg-do compile }
2
! { dg-options "-std=f95" }
3
!
4
! PR fortran/27997
5
!
6
! Array constructor with typespec
7
! should be rejected for Fortran 95.
8
!
9
real :: a(3)
10
integer :: j(3)
11
a = (/ integer :: 1.4, 2.2, 3.33  /) ! { dg-error "Fortran 2003" }
12
j = (/ 1.4, 2.2, 3.33  /)
13
if( any(a /= j )) call abort()
14
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

Return to bug 27997