[Patch, fortran] PR29642 - Fortran 2003: VALUE Attribute (pass by value)
Paul Thomas
paulthomas2@wanadoo.fr
Fri Nov 17 22:32:00 GMT 2006
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 (¤t_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 (¤t_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
>
More information about the Fortran
mailing list