User account creation filtered due to spam.

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

Collapse All | Expand All

(-)gcc/fortran/array.c (-14 / +76 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
      else
917
        gfc_current_locus = where;
918
    }
919
902
  if (gfc_match (end_delim) == MATCH_YES)
920
  if (gfc_match (end_delim) == MATCH_YES)
903
    {
921
    {
904
      gfc_error ("Empty array constructor at %C is not allowed");
922
      if (seen_ts)
905
      goto cleanup;
923
	goto done;
924
      else
925
	{
926
	  gfc_error ("Empty array constructor at %C is not allowed");
927
	  goto cleanup;
928
	}
906
    }
929
    }
907
930
908
  for (;;)
931
  for (;;)
Lines 927-932 Link Here
927
  if (gfc_match (end_delim) == MATCH_NO)
950
  if (gfc_match (end_delim) == MATCH_NO)
928
    goto syntax;
951
    goto syntax;
929
952
953
done:
930
  expr = gfc_get_expr ();
954
  expr = gfc_get_expr ();
931
955
932
  expr->expr_type = EXPR_ARRAY;
956
  expr->expr_type = EXPR_ARRAY;
Lines 934-939 Link Here
934
  expr->value.constructor = head;
958
  expr->value.constructor = head;
935
  /* Size must be calculated at resolution time.  */
959
  /* Size must be calculated at resolution time.  */
936
960
961
  if (seen_ts)
962
    expr->ts = ts;
963
  else
964
    expr->ts.type = BT_UNKNOWN;
965
937
  expr->where = where;
966
  expr->where = where;
938
  expr->rank = 1;
967
  expr->rank = 1;
939
968
Lines 964-970 Link Here
964
cons_state;
993
cons_state;
965
994
966
static int
995
static int
967
check_element_type (gfc_expr *expr)
996
check_element_type (gfc_expr *expr, bool convert)
968
{
997
{
969
  if (cons_state == CONS_BAD)
998
  if (cons_state == CONS_BAD)
970
    return 0;			/* Suppress further errors */
999
    return 0;			/* Suppress further errors */
Lines 985-990 Link Here
985
  if (gfc_compare_types (&constructor_ts, &expr->ts))
1014
  if (gfc_compare_types (&constructor_ts, &expr->ts))
986
    return 0;
1015
    return 0;
987
1016
1017
  if (convert)
1018
    return gfc_convert_type (expr, &constructor_ts, 1) == SUCCESS ? 0 : 1;
1019
988
  gfc_error ("Element in %s array constructor at %L is %s",
1020
  gfc_error ("Element in %s array constructor at %L is %s",
989
	     gfc_typename (&constructor_ts), &expr->where,
1021
	     gfc_typename (&constructor_ts), &expr->where,
990
	     gfc_typename (&expr->ts));
1022
	     gfc_typename (&expr->ts));
Lines 997-1003 Link Here
997
/* Recursive work function for gfc_check_constructor_type().  */
1029
/* Recursive work function for gfc_check_constructor_type().  */
998
1030
999
static try
1031
static try
1000
check_constructor_type (gfc_constructor *c)
1032
check_constructor_type (gfc_constructor *c, bool convert)
1001
{
1033
{
1002
  gfc_expr *e;
1034
  gfc_expr *e;
1003
1035
Lines 1007-1019 Link Here
1007
1039
1008
      if (e->expr_type == EXPR_ARRAY)
1040
      if (e->expr_type == EXPR_ARRAY)
1009
	{
1041
	{
1010
	  if (check_constructor_type (e->value.constructor) == FAILURE)
1042
	  if (check_constructor_type (e->value.constructor, convert) == FAILURE)
1011
	    return FAILURE;
1043
	    return FAILURE;
1012
1044
1013
	  continue;
1045
	  continue;
1014
	}
1046
	}
1015
1047
1016
      if (check_element_type (e))
1048
      if (check_element_type (e, convert))
1017
	return FAILURE;
1049
	return FAILURE;
1018
    }
1050
    }
1019
1051
Lines 1029-1038 Link Here
1029
{
1061
{
1030
  try t;
1062
  try t;
1031
1063
1032
  cons_state = CONS_START;
1064
  if (e->ts.type != BT_UNKNOWN)
1033
  gfc_clear_ts (&constructor_ts);
1065
    {
1066
      cons_state = CONS_GOOD;
1067
      constructor_ts = e->ts;
1068
    }
1069
  else
1070
    {
1071
      cons_state = CONS_START;
1072
      gfc_clear_ts (&constructor_ts);
1073
    }
1034
1074
1035
  t = check_constructor_type (e->value.constructor);
1075
  /* If e->ts.type != BT_UNKNOWN, the array constructor included a
1076
     typespec, and we will now convert the values on the fly.  */
1077
  t = check_constructor_type (e->value.constructor, e->ts.type != BT_UNKNOWN);
1036
  if (t == SUCCESS && e->ts.type == BT_UNKNOWN)
1078
  if (t == SUCCESS && e->ts.type == BT_UNKNOWN)
1037
    e->ts = constructor_ts;
1079
    e->ts = constructor_ts;
1038
1080
Lines 1526-1532 Link Here
1526
1568
1527
/* Resolve character array constructor. If it is a constant character array and
1569
/* Resolve character array constructor. If it is a constant character array and
1528
   not specified character length, update character length to the maximum of
1570
   not specified character length, update character length to the maximum of
1529
   its element constructors' length.  */
1571
   its element constructors' length.  For arrays with fixed length, pad the
1572
   elements as necessary with needed_length. */
1530
1573
1531
void
1574
void
1532
gfc_resolve_character_array_constructor (gfc_expr *expr)
1575
gfc_resolve_character_array_constructor (gfc_expr *expr)
Lines 1596-1607 Link Here
1596
	{
1639
	{
1597
	  /* Update the character length of the array constructor.  */
1640
	  /* Update the character length of the array constructor.  */
1598
	  expr->ts.cl->length = gfc_int_expr (max_length);
1641
	  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
	}
1642
	}
1604
    }
1643
    }
1644
  else 
1645
    {
1646
      /* We've got a character length specified.  It should be an integer,
1647
         otherwise an error is signalled elsewhere.  */
1648
      gcc_assert (expr->ts.cl->length);
1649
      if (expr->ts.cl->length->ts.type == BT_INTEGER)
1650
        {
1651
          if (expr->ts.cl->length->expr_type == EXPR_CONSTANT)
1652
            {
1653
              /* Got a constant character length, pad according to this */
1654
              max_length = mpz_get_si (expr->ts.cl->length->value.integer);
1655
            }
1656
        }
1657
    }
1658
1659
  /* Found a length to update to, do it.  */
1660
  if (max_length != -1)
1661
    {
1662
      /* Update the element constructors.  */
1663
      for (p = expr->value.constructor; p; p = p->next)
1664
        if (p->expr->expr_type == EXPR_CONSTANT)
1665
          gfc_set_constant_character_len (max_length, p->expr, true);
1666
    }
1605
}
1667
}
1606
1668
1607
1669
(-)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_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_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