This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Re: [Patch, fortran] PR29642 - Fortran 2003: VALUE Attribute (pass by value)


Ping! Tobias, what about you reviewing this?

The %VAL patch has hit a slight consistency problem (g77 vs vms) that I will have to sort out before submitting

Paul
:ADDPATCH fortran:

The attached patch supplies an implementation of the VALUE attribute and three associated testscases.

The patch consists of a repetition of the code that implements other attributes, such as TARGET or VOLATILE. In addition, two small changes are needed to pass by value (gfc_conv_function_call) and to treat a dummy as having been passed by value (gfc_conv_variable and gfc_sym_type).

The first test case checks the functionality of the patch; that a reasonable sprinkling of types and kinds are passed correctly, that it is the value that is passed and the modules do the right thing. The second testcase check that -std=F2003 is applied. The third checks the constraints on the value attribute. Allocatable has been included in the conflicts but I could not get it to do anything because the compiler either grumbled that the variable was not a scalar or that the allocatable attribute had to be applied to an array.

A patch for %VAL, %LOC and %REF is on its way in the next 24hours. It turned out that they are completely separate from each other, even though, at first sight, the functionality is not disimilar.

Regtested on Cygwin_NT/amd64 - OK for trunk?

Paul

2006-11-14 Paul Thomas <pault@gcc.gnu.org>

   PR fortran/29642
   * trans-expr.c (gfc_conv_variable): A character expression with
   the VALUE attribute needs an address expression; otherwise all
   other expressions with this attribute must not be dereferenced.
   (gfc_conv_function_call): Pass expressions with the VALUE
   attribute by value, using gfc_conv_expr.
   * symbol.c (check_conflict): Add strings for INTENT OUT, INOUT
   and VALUE.  Apply all the constraints associated with the VALUE
   attribute.
   (gfc_add_value): New function.
   (gfc_copy_attr): Call it for VALUE attribute.
   * decl.c (match_attr_spec): Include the VALUE attribute.
   (gfc_match_value): New function.
   * dump-parse-tree.c (gfc_show_attr): Include VALUE.
   * gfortran.h : Add value to the symbol_attribute structure and
   add a prototype for gfc_add_value
   * module.c (mio_internal_string): Include AB_VALUE in enum.
   (attr_bits): Provide the VALUE string for it.
   (mio_symbol_attribute): Read or apply the VLUE attribute.
   * trans-types.c (gfc_sym_type): Variables with the VLAUE
   attribute are not passed by reference!
   * resolve.c (was_declared): Add value to those that return 1.
   * match.h : Add prototype for gfc_match_public.
   * parse.c (decode_statement): Try to match a VALUE statement.


2006-11-14 Paul Thomas <pault@gcc.gnu.org>


   PR fortran/29642
   * gfortran.dg/value_1.f90 : New test.
   * gfortran.dg/value_2.f90 : New test.
   * gfortran.dg/value_2.f90 : New test.



------------------------------------------------------------------------

Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c (revision 118704)
--- gcc/fortran/trans-expr.c (working copy)
*************** gfc_conv_variable (gfc_se * se, gfc_expr
*** 416,430 ****
separately. */
if (sym->ts.type == BT_CHARACTER)
{
! /* Dereference character pointer dummy arguments
or results. */
if ((sym->attr.pointer || sym->attr.allocatable)
&& (sym->attr.dummy
|| sym->attr.function
|| sym->attr.result))
se->expr = build_fold_indirect_ref (se->expr);
}
! else
{
/* Dereference non-character scalar dummy arguments. */
if (sym->attr.dummy && !sym->attr.dimension)
--- 416,436 ----
separately. */
if (sym->ts.type == BT_CHARACTER)
{
! /* Dereference character pointer dummy arguments
or results. */
if ((sym->attr.pointer || sym->attr.allocatable)
&& (sym->attr.dummy
|| sym->attr.function
|| sym->attr.result))
se->expr = build_fold_indirect_ref (se->expr);
+ + /* A character with VALUE attribute needs an address
+ expression. */
+ if (sym->attr.value)
+ se->expr = build_fold_addr_expr (se->expr);
+ }
! else if (!sym->attr.value)
{
/* Dereference non-character scalar dummy arguments. */
if (sym->attr.dummy && !sym->attr.dimension)
*************** gfc_conv_function_call (gfc_se * se, gfc
*** 1973,1991 ****
argss = gfc_walk_expr (e);
if (argss == gfc_ss_terminator)
! {
! gfc_conv_expr_reference (&parmse, e);
parm_kind = SCALAR;
! if (fsym && fsym->attr.pointer
! && e->expr_type != EXPR_NULL)
! {
! /* Scalar pointer dummy args require an extra level of
! indirection. The null pointer already contains
! this level of indirection. */
! parm_kind = SCALAR_POINTER;
! parmse.expr = build_fold_addr_expr (parmse.expr);
! }
! }
else
{
/* If the procedure requires an explicit interface, the actual
--- 1979,2004 ----
argss = gfc_walk_expr (e);
if (argss == gfc_ss_terminator)
! {
parm_kind = SCALAR;
! if (fsym && fsym->attr.value)
! {
! gfc_conv_expr (&parmse, e);
! }
! else
! {
! gfc_conv_expr_reference (&parmse, e);
! if (fsym && fsym->attr.pointer
! && e->expr_type != EXPR_NULL)
! {
! /* Scalar pointer dummy args require an extra level of
! indirection. The null pointer already contains
! this level of indirection. */
! parm_kind = SCALAR_POINTER;
! parmse.expr = build_fold_addr_expr (parmse.expr);
! }
! }
! }
else
{
/* If the procedure requires an explicit interface, the actual
Index: gcc/fortran/symbol.c
===================================================================
*** gcc/fortran/symbol.c (revision 118704)
--- gcc/fortran/symbol.c (working copy)
*************** check_conflict (symbol_attribute * attr,
*** 266,271 ****
--- 266,272 ----
static const char *dummy = "DUMMY", *save = "SAVE", *pointer = "POINTER",
*target = "TARGET", *external = "EXTERNAL", *intent = "INTENT",
*intent_in = "INTENT(IN)", *intrinsic = "INTRINSIC",
+ *intent_out = "INTENT(OUT)", *intent_inout = "INTENT(INOUT)",
*allocatable = "ALLOCATABLE", *elemental = "ELEMENTAL",
*private = "PRIVATE", *recursive = "RECURSIVE",
*in_common = "COMMON", *result = "RESULT", *in_namelist = "NAMELIST",
*************** check_conflict (symbol_attribute * attr,
*** 273,279 ****
*function = "FUNCTION", *subroutine = "SUBROUTINE",
*dimension = "DIMENSION", *in_equivalence = "EQUIVALENCE",
*use_assoc = "USE ASSOCIATED", *cray_pointer = "CRAY POINTER",
! *cray_pointee = "CRAY POINTEE", *data = "DATA", *volatile_ = "VOLATILE";
static const char *threadprivate = "THREADPRIVATE";
const char *a1, *a2;
--- 274,281 ----
*function = "FUNCTION", *subroutine = "SUBROUTINE",
*dimension = "DIMENSION", *in_equivalence = "EQUIVALENCE",
*use_assoc = "USE ASSOCIATED", *cray_pointer = "CRAY POINTER",
! *cray_pointee = "CRAY POINTEE", *data = "DATA", *value = "VALUE",
! *volatile_ = "VOLATILE";
static const char *threadprivate = "THREADPRIVATE";
const char *a1, *a2;
*************** check_conflict (symbol_attribute * attr,
*** 400,405 ****
--- 402,421 ----
conf (data, allocatable);
conf (data, use_assoc);
+ conf (value, pointer)
+ conf (value, allocatable)
+ conf (value, subroutine)
+ conf (value, function)
+ conf (value, volatile_)
+ conf (value, dimension)
+ + if (attr->value && (attr->intent == INTENT_OUT || attr->intent == INTENT_INOUT))
+ {
+ a1 = value;
+ a2 = attr->intent == INTENT_OUT ? intent_out : intent_inout;
+ goto conflict;
+ }
+ conf (volatile_, intrinsic)
conf (volatile_, external)
*************** gfc_add_save (symbol_attribute * attr, c
*** 800,805 ****
--- 816,841 ----
}
try
+ gfc_add_value (symbol_attribute * attr, const char *name, locus * where)
+ {
+ + if (check_used (attr, name, where))
+ return FAILURE;
+ + if (attr->value)
+ {
+ if (gfc_notify_std (GFC_STD_LEGACY, + "Duplicate VALUE attribute specified at %L",
+ where) + == FAILURE)
+ return FAILURE;
+ }
+ + attr->value = 1;
+ return check_conflict (attr, name, where);
+ }
+ + try
gfc_add_volatile (symbol_attribute * attr, const char *name, locus * where)
{
*************** gfc_copy_attr (symbol_attribute * dest, *** 1252,1257 ****
--- 1288,1295 ----
goto fail;
if (src->save && gfc_add_save (dest, NULL, where) == FAILURE)
goto fail;
+ if (src->value && gfc_add_value (dest, NULL, where) == FAILURE)
+ goto fail;
if (src->volatile_ && gfc_add_volatile (dest, NULL, where) == FAILURE)
goto fail;
if (src->threadprivate && gfc_add_threadprivate (dest, NULL, where) == FAILURE)
Index: gcc/fortran/decl.c
===================================================================
*** gcc/fortran/decl.c (revision 118704)
--- gcc/fortran/decl.c (working copy)
*************** match_attr_spec (void)
*** 2026,2032 ****
DECL_ALLOCATABLE = GFC_DECL_BEGIN, DECL_DIMENSION, DECL_EXTERNAL,
DECL_IN, DECL_OUT, DECL_INOUT, DECL_INTRINSIC, DECL_OPTIONAL,
DECL_PARAMETER, DECL_POINTER, DECL_PRIVATE, DECL_PUBLIC, DECL_SAVE,
! DECL_TARGET, DECL_VOLATILE, DECL_COLON, DECL_NONE,
GFC_DECL_END /* Sentinel */
}
decl_types;
--- 2026,2032 ----
DECL_ALLOCATABLE = GFC_DECL_BEGIN, DECL_DIMENSION, DECL_EXTERNAL,
DECL_IN, DECL_OUT, DECL_INOUT, DECL_INTRINSIC, DECL_OPTIONAL,
DECL_PARAMETER, DECL_POINTER, DECL_PRIVATE, DECL_PUBLIC, DECL_SAVE,
! DECL_TARGET, DECL_VALUE, DECL_VOLATILE, DECL_COLON, DECL_NONE,
GFC_DECL_END /* Sentinel */
}
decl_types;
*************** match_attr_spec (void)
*** 2049,2054 ****
--- 2049,2055 ----
minit (", public", DECL_PUBLIC),
minit (", save", DECL_SAVE),
minit (", target", DECL_TARGET),
+ minit (", value", DECL_VALUE),
minit (", volatile", DECL_VOLATILE),
minit ("::", DECL_COLON),
minit (NULL, DECL_NONE)
*************** match_attr_spec (void)
*** 2170,2175 ****
--- 2171,2179 ----
case DECL_TARGET:
attr = "TARGET";
break;
+ case DECL_VALUE:
+ attr = "VALUE";
+ break;
case DECL_VOLATILE:
attr = "VOLATILE";
break;
*************** match_attr_spec (void)
*** 2287,2292 ****
--- 2291,2305 ----
t = gfc_add_target (&current_attr, &seen_at[d]);
break;
+ case DECL_VALUE:
+ if (gfc_notify_std (GFC_STD_F2003,
+ "Fortran 2003: VALUE attribute at %C")
+ == FAILURE)
+ t = FAILURE;
+ else
+ t = gfc_add_value (&current_attr, NULL, &seen_at[d]);
+ break;
+ case DECL_VOLATILE:
if (gfc_notify_std (GFC_STD_F2003,
"Fortran 2003: VOLATILE attribute at %C")
*************** syntax:
*** 3960,3965 ****
--- 3973,4029 ----
match
+ gfc_match_value (void)
+ {
+ gfc_symbol *sym;
+ match m;
+ + if (gfc_notify_std (GFC_STD_F2003, + "Fortran 2003: VALUE statement at %C")
+ == FAILURE)
+ return MATCH_ERROR;
+ + if (gfc_match (" ::") == MATCH_NO && gfc_match_space () == MATCH_NO)
+ {
+ return MATCH_ERROR;
+ }
+ + if (gfc_match_eos () == MATCH_YES)
+ goto syntax;
+ + for(;;)
+ {
+ m = gfc_match_symbol (&sym, 0);
+ switch (m)
+ {
+ case MATCH_YES:
+ if (gfc_add_value (&sym->attr, sym->name,
+ &gfc_current_locus) == FAILURE)
+ return MATCH_ERROR;
+ goto next_item;
+ + case MATCH_NO:
+ break;
+ + case MATCH_ERROR:
+ return MATCH_ERROR;
+ }
+ + next_item:
+ if (gfc_match_eos () == MATCH_YES)
+ break;
+ if (gfc_match_char (',') != MATCH_YES)
+ goto syntax;
+ }
+ + return MATCH_YES;
+ + syntax:
+ gfc_error ("Syntax error in VALUE statement at %C");
+ return MATCH_ERROR;
+ }
+ + match
gfc_match_volatile (void)
{
gfc_symbol *sym;
Index: gcc/fortran/dump-parse-tree.c
===================================================================
*** gcc/fortran/dump-parse-tree.c (revision 118704)
--- gcc/fortran/dump-parse-tree.c (working copy)
*************** gfc_show_attr (symbol_attribute * attr)
*** 552,557 ****
--- 552,559 ----
gfc_status (" POINTER");
if (attr->save)
gfc_status (" SAVE");
+ if (attr->value)
+ gfc_status (" VALUE");
if (attr->volatile_)
gfc_status (" VOLATILE");
if (attr->threadprivate)
Index: gcc/fortran/gfortran.h
===================================================================
*** gcc/fortran/gfortran.h (revision 118704)
--- gcc/fortran/gfortran.h (working copy)
*************** typedef struct
*** 477,483 ****
{
/* Variable attributes. */
unsigned allocatable:1, dimension:1, external:1, intrinsic:1,
! optional:1, pointer:1, save:1, target:1, volatile_:1,
dummy:1, result:1, assign:1, threadprivate:1;
unsigned data:1, /* Symbol is named in a DATA statement. */
--- 477,483 ----
{
/* Variable attributes. */
unsigned allocatable:1, dimension:1, external:1, intrinsic:1,
! optional:1, pointer:1, save:1, target:1, value:1, volatile_:1,
dummy:1, result:1, assign:1, threadprivate:1;
unsigned data:1, /* Symbol is named in a DATA statement. */
*************** try gfc_add_pure (symbol_attribute *, lo
*** 1865,1870 ****
--- 1865,1871 ----
try gfc_add_recursive (symbol_attribute *, locus *);
try gfc_add_function (symbol_attribute *, const char *, locus *);
try gfc_add_subroutine (symbol_attribute *, const char *, locus *);
+ try gfc_add_value (symbol_attribute *, const char *, locus *);
try gfc_add_volatile (symbol_attribute *, const char *, locus *);
try gfc_add_access (symbol_attribute *, gfc_access, const char *, locus *);
Index: gcc/fortran/module.c
===================================================================
*** gcc/fortran/module.c (revision 118704)
--- gcc/fortran/module.c (working copy)
*************** mio_internal_string (char *string)
*** 1431,1441 ****
typedef enum
{ AB_ALLOCATABLE, AB_DIMENSION, AB_EXTERNAL, AB_INTRINSIC, AB_OPTIONAL,
! AB_POINTER, AB_SAVE, AB_TARGET, AB_DUMMY, AB_RESULT,
! AB_DATA, AB_IN_NAMELIST, AB_IN_COMMON, ! AB_FUNCTION, AB_SUBROUTINE, AB_SEQUENCE, AB_ELEMENTAL, AB_PURE,
! AB_RECURSIVE, AB_GENERIC, AB_ALWAYS_EXPLICIT, AB_CRAY_POINTER,
! AB_CRAY_POINTEE, AB_THREADPRIVATE, AB_ALLOC_COMP, AB_VOLATILE
}
ab_attribute;
--- 1431,1441 ----
typedef enum
{ AB_ALLOCATABLE, AB_DIMENSION, AB_EXTERNAL, AB_INTRINSIC, AB_OPTIONAL,
! AB_POINTER, AB_SAVE, AB_TARGET, AB_DUMMY, AB_RESULT, AB_DATA,
! AB_IN_NAMELIST, AB_IN_COMMON, AB_FUNCTION, AB_SUBROUTINE, AB_SEQUENCE,
! AB_ELEMENTAL, AB_PURE, AB_RECURSIVE, AB_GENERIC, AB_ALWAYS_EXPLICIT,
! AB_CRAY_POINTER, AB_CRAY_POINTEE, AB_THREADPRIVATE, AB_ALLOC_COMP,
! AB_VALUE, AB_VOLATILE
}
ab_attribute;
*************** static const mstring attr_bits[] =
*** 1448,1453 ****
--- 1448,1454 ----
minit ("OPTIONAL", AB_OPTIONAL),
minit ("POINTER", AB_POINTER),
minit ("SAVE", AB_SAVE),
+ minit ("VALUE", AB_VALUE),
minit ("VOLATILE", AB_VOLATILE),
minit ("TARGET", AB_TARGET),
minit ("THREADPRIVATE", AB_THREADPRIVATE),
*************** mio_symbol_attribute (symbol_attribute *
*** 1519,1524 ****
--- 1520,1527 ----
MIO_NAME(ab_attribute) (AB_POINTER, attr_bits);
if (attr->save)
MIO_NAME(ab_attribute) (AB_SAVE, attr_bits);
+ if (attr->value)
+ MIO_NAME(ab_attribute) (AB_VALUE, attr_bits);
if (attr->volatile_)
MIO_NAME(ab_attribute) (AB_VOLATILE, attr_bits);
if (attr->target)
*************** mio_symbol_attribute (symbol_attribute *
*** 1599,1604 ****
--- 1602,1610 ----
case AB_SAVE:
attr->save = 1;
break;
+ case AB_VALUE:
+ attr->value = 1;
+ break;
case AB_VOLATILE:
attr->volatile_ = 1;
break;
Index: gcc/fortran/trans-types.c
===================================================================
*** gcc/fortran/trans-types.c (revision 118704)
--- gcc/fortran/trans-types.c (working copy)
*************** gfc_sym_type (gfc_symbol * sym)
*** 1327,1333 ****
sym->ts.kind = gfc_default_real_kind;
}
! if (sym->attr.dummy && !sym->attr.function)
byref = 1;
else
byref = 0;
--- 1327,1333 ----
sym->ts.kind = gfc_default_real_kind;
}
! if (sym->attr.dummy && !sym->attr.function && !sym->attr.value)
byref = 1;
else
byref = 0;
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (revision 118704)
--- gcc/fortran/resolve.c (working copy)
*************** was_declared (gfc_symbol * sym)
*** 677,683 ****
return 1;
if (a.allocatable || a.dimension || a.dummy || a.external || a.intrinsic
! || a.optional || a.pointer || a.save || a.target || a.volatile_
|| a.access != ACCESS_UNKNOWN || a.intent != INTENT_UNKNOWN)
return 1;
--- 677,683 ----
return 1;
if (a.allocatable || a.dimension || a.dummy || a.external || a.intrinsic
! || a.optional || a.pointer || a.save || a.target || a.volatile_ || a.value
|| a.access != ACCESS_UNKNOWN || a.intent != INTENT_UNKNOWN)
return 1;
Index: gcc/fortran/match.h
===================================================================
*** gcc/fortran/match.h (revision 118704)
--- gcc/fortran/match.h (working copy)
*************** match gfc_match_public (gfc_statement *)
*** 146,151 ****
--- 146,152 ----
match gfc_match_save (void);
match gfc_match_modproc (void);
match gfc_match_target (void);
+ match gfc_match_value (void);
match gfc_match_volatile (void);
/* primary.c */
Index: gcc/fortran/parse.c
===================================================================
*** gcc/fortran/parse.c (revision 118704)
--- gcc/fortran/parse.c (working copy)
*************** decode_statement (void)
*** 283,288 ****
--- 283,289 ----
break;
case 'v':
+ match ("value", gfc_match_value, ST_ATTR_DECL);
match ("volatile", gfc_match_volatile, ST_ATTR_DECL);
break;
Index: gcc/testsuite/gfortran.dg/value_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/value_1.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/value_1.f90 (revision 0)
***************
*** 0 ****
--- 1,80 ----
+ ! { dg-do run }
+ ! { dg-options "-std=gnu" }
+ ! Tests the functionality of the patch for PR29642, which requested the
+ ! implementation of the F2003 VALUE attribute for gfortran.
+ !
+ ! Contributed by Paul Thomas <pault@gcc.gnu.org> + !
+ module global
+ type :: mytype
+ real(4) :: x
+ character(4) :: c
+ end type mytype
+ contains
+ subroutine typhoo (dt)
+ type(mytype), value :: dt
+ if (dtne (dt, mytype (acos(0.0), "lmno"))) call abort ()
+ dt = mytype (acos(0.0)/2.0, "wxyz")
+ if (dtne (dt, mytype (acos(0.0)/2.0, "wxyz"))) call abort ()
+ end subroutine typhoo
+ + logical function dtne (a, b)
+ type(mytype) :: a, b
+ dtne = .FALSE.
+ if ((a%x /= b%x) .or. (a%c /= b%c)) dtne = .TRUE.
+ end function dtne
+ end module global
+ + program test_value
+ use global
+ integer(8) :: i = 42
+ real(8) :: r = 42.0
+ character(2) :: c = "ab"
+ complex(8) :: z = (-99.0, 199.0)
+ type(mytype) :: dt = mytype (acos(0.0), "lmno")
+ + call foo (c)
+ if (c /= "ab") call abort ()
+ + call bar (i)
+ if (i /= 42) call abort ()
+ + call foobar (r)
+ if (r /= 42.0) call abort ()
+ + call complex_foo (z)
+ if (z /= (-99.0, 199.0)) call abort ()
+ + call typhoo (dt)
+ if (dtne (dt, mytype (acos(0.0), "lmno"))) call abort ()
+ contains
+ subroutine foo (c)
+ character(2), value :: c
+ if (c /= "ab") call abort ()
+ c = "cd"
+ if (c /= "cd") call abort ()
+ end subroutine foo
+ + subroutine bar (i)
+ integer(8), value :: i
+ if (i /= 42) call abort ()
+ i = 99
+ if (i /= 99) call abort ()
+ end subroutine bar
+ + subroutine foobar (r)
+ real(8), value :: r
+ if (r /= 42.0) call abort ()
+ r = 99.0
+ if (r /= 99.0) call abort ()
+ end subroutine foobar
+ + subroutine complex_foo (z)
+ COMPLEX(8), value :: z
+ if (z /= (-99.0, 199.0)) call abort ()
+ z = (77.0, -42.0)
+ if (z /= (77.0, -42.0)) call abort ()
+ end subroutine complex_foo
+ + end program test_value
+ ! { dg-final { cleanup-modules "global" } }
Index: gcc/testsuite/gfortran.dg/value_2.f90
===================================================================
*** gcc/testsuite/gfortran.dg/value_2.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/value_2.f90 (revision 0)
***************
*** 0 ****
--- 1,21 ----
+ ! { dg-do compile }
+ ! { dg-options "-std=f95" }
+ ! Tests the standard check in the patch for PR29642, which requested the
+ ! implementation of the F2003 VALUE attribute for gfortran.
+ !
+ ! Contributed by Paul Thomas <pault@gcc.gnu.org> + !
+ program test_value
+ integer(8) :: i = 42
+ + call bar (i)
+ if (i /= 42) call abort ()
+ contains
+ subroutine bar (i)
+ integer(8) :: i
+ value :: i ! { dg-error "Fortran 2003: VALUE" }
+ if (i /= 42) call abort ()
+ i = 99
+ if (i /= 99) call abort ()
+ end subroutine bar
+ end program test_value
Index: gcc/testsuite/gfortran.dg/value_3.f90
===================================================================
*** gcc/testsuite/gfortran.dg/value_3.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/value_3.f90 (revision 0)
***************
*** 0 ****
--- 1,42 ----
+ ! { dg-do compile }
+ ! Tests the constraints in the patch for PR29642, which requested the
+ ! implementation of the F2003 VALUE attribute for gfortran.
+ !
+ ! Contributed by Paul Thomas <pault@gcc.gnu.org> + !
+ program test_value
+ integer(8) :: i = 42
+ + contains
+ subroutine bar_1 (i)
+ integer(8) :: i
+ dimension i(8)
+ value :: i ! { dg-error "conflicts with DIMENSION" }
+ i = 0
+ end subroutine bar_1
+ + subroutine bar_2 (i)
+ integer(8) :: i
+ pointer :: i
+ value :: i ! { dg-error "conflicts with POINTER" }
+ i = 0
+ end subroutine bar_2
+ + integer function bar_3 (i)
+ integer(8) :: i
+ dimension i(8)
+ value :: bar_3 ! { dg-error "conflicts with FUNCTION" }
+ i = 0
+ bar_3 = 0
+ end function bar_3
+ + subroutine bar_4 (i, j)
+ integer(8), intent(inout) :: i
+ integer(8), intent(out) :: j
+ value :: i ! { dg-error "conflicts with INTENT" }
+ value :: j ! { dg-error "conflicts with INTENT" }
+ i = 0
+ j = 0
+ end subroutine bar_4
+ + end program test_value


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]