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_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 (+21 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
  !write (*,*) a
14
  if(     a(1) /= 'Takata'  .or. a(1)(7:7)   /= achar(32) &
15
                            .or. a(1)(15:15) /= achar(32) &
16
     .or. a(2) /= 'Tanaka'  .or. a(2)(7:7)   /= achar(32) &
17
                            .or. a(2)(15:15) /= achar(32) &
18
     .or. a(3) /= 'Hayashi' .or. a(3)(8:8)   /= achar(32) &
19
                            .or. a(3)(15:15) /= achar(32))&
20
   call abort()
21
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/array.c (-9 / +51 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

Return to bug 27997