[v3] Fortran: restrictions on integer arguments to SYSTEM_CLOCK [PR112609]
Checks
Context |
Check |
Description |
linaro-tcwg-bot/tcwg_gcc_build--master-aarch64 |
success
|
Testing passed
|
linaro-tcwg-bot/tcwg_gcc_build--master-arm |
success
|
Testing passed
|
linaro-tcwg-bot/tcwg_gcc_check--master-arm |
fail
|
Testing failed
|
linaro-tcwg-bot/tcwg_gcc_check--master-aarch64 |
fail
|
Testing failed
|
Commit Message
Hi Mikael, Steve,
On 11/21/23 12:33, Mikael Morin wrote:
> Harald, you mentioned the lack of GFC_STD_F2023_DEL feature group in
> your first message, but I don't quite understand why you didn't add one.
> It seems to me the most natural way to do this.
thanks for insisting on this variant.
In my first attack at this problem, I overlooked one place in
libgfortran.h, which I now was able to find and adjust.
Now everything falls into place.
> I suggest we emit a warning by default, error with -std=f2023 (I agree
> with Steve that we should push towards strict f2023 conformance), and no
> diagnostic with -std=gnu or -std=f2018 or lower.
As the majority agrees on this, I accept it. The attached patch
now does this and fixes the testcases accordingly.
>> It seems that the solution is to fix the code in the testsuite.
>
> Agreed, these seem to explicitly test mismatching kinds, so add an
> option to prevent error.
Done.
I also fixed a few issues in the documentation in gfortran.texi .
As I currently cannot build a full compiler (see PR112643),
patch V3 is not properly regtested yet, but appears to give
results as discussed.
Comments?
> Mikael
Thanks,
Harald
Comments
Uhh, it happened again. Attached a wrong patch.
Only looked at the -v3 ... My bad.
Sorry!
Harald
On 11/21/23 22:54, Harald Anlauf wrote:
> Hi Mikael, Steve,
>
> On 11/21/23 12:33, Mikael Morin wrote:
>> Harald, you mentioned the lack of GFC_STD_F2023_DEL feature group in
>> your first message, but I don't quite understand why you didn't add one.
>> It seems to me the most natural way to do this.
>
> thanks for insisting on this variant.
>
> In my first attack at this problem, I overlooked one place in
> libgfortran.h, which I now was able to find and adjust.
> Now everything falls into place.
>
>> I suggest we emit a warning by default, error with -std=f2023 (I agree
>> with Steve that we should push towards strict f2023 conformance), and no
>> diagnostic with -std=gnu or -std=f2018 or lower.
>
> As the majority agrees on this, I accept it. The attached patch
> now does this and fixes the testcases accordingly.
>
>>> It seems that the solution is to fix the code in the testsuite.
>>
>> Agreed, these seem to explicitly test mismatching kinds, so add an
>> option to prevent error.
>
> Done.
>
> I also fixed a few issues in the documentation in gfortran.texi .
>
> As I currently cannot build a full compiler (see PR112643),
> patch V3 is not properly regtested yet, but appears to give
> results as discussed.
>
> Comments?
>
>> Mikael
>
> Thanks,
> Harald
>
>
Le 21/11/2023 à 23:09, Harald Anlauf a écrit :
> Uhh, it happened again. Attached a wrong patch.
> Only looked at the -v3 ... My bad.
>
> Sorry!
>
> Harald
>
>
> On 11/21/23 22:54, Harald Anlauf wrote:
>> Hi Mikael, Steve,
>>
>> On 11/21/23 12:33, Mikael Morin wrote:
>>> Harald, you mentioned the lack of GFC_STD_F2023_DEL feature group in
>>> your first message, but I don't quite understand why you didn't add one.
>>> It seems to me the most natural way to do this.
>>
>> thanks for insisting on this variant.
>>
>> In my first attack at this problem, I overlooked one place in
>> libgfortran.h, which I now was able to find and adjust.
>> Now everything falls into place.
>>
>>> I suggest we emit a warning by default, error with -std=f2023 (I agree
>>> with Steve that we should push towards strict f2023 conformance), and no
>>> diagnostic with -std=gnu or -std=f2018 or lower.
>>
>> As the majority agrees on this, I accept it. The attached patch
>> now does this and fixes the testcases accordingly.
>>
>>>> It seems that the solution is to fix the code in the testsuite.
>>>
>>> Agreed, these seem to explicitly test mismatching kinds, so add an
>>> option to prevent error.
>>
>> Done.
>>
>> I also fixed a few issues in the documentation in gfortran.texi .
>>
>> As I currently cannot build a full compiler (see PR112643),
>> patch V3 is not properly regtested yet, but appears to give
>> results as discussed.
>>
>> Comments?
>>
>>> Mikael
>>
>> Thanks,
>> Harald
>>
>>
>
(...)
> diff --git a/gcc/fortran/error.cc b/gcc/fortran/error.cc
> index 2ac51e95e4d..be715b50469 100644
> --- a/gcc/fortran/error.cc
> +++ b/gcc/fortran/error.cc
> @@ -980,7 +980,11 @@ char const*
> notify_std_msg(int std)
> {
>
> - if (std & GFC_STD_F2018_DEL)
> + if (std & GFC_STD_F2023_DEL)
> + return _("Fortran 2023 deleted feature:");
As there are officially no deleted feature in f2023, maybe use a
slightly different wording? Say "Not allowed in fortran 2023" or
"forbidden in Fortran 2023" or similar?
> + else if (std & GFC_STD_F2023)
> + return _("Fortran 2023:");
> + else if (std & GFC_STD_F2018_DEL)
> return _("Fortran 2018 deleted feature:");
> else if (std & GFC_STD_F2018_OBS)
> return _("Fortran 2018 obsolescent feature:");
> diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h
> index bdddb317ab0..af7a170c2b1 100644
> --- a/gcc/fortran/libgfortran.h
> +++ b/gcc/fortran/libgfortran.h
> @@ -19,9 +19,10 @@ along with GCC; see the file COPYING3. If not see
>
>
> /* Flags to specify which standard/extension contains a feature.
> - Note that no features were obsoleted nor deleted in F2003 nor in F2023.
> + Note that no features were obsoleted nor deleted in F2003.
I think we can add a comment that F2023 has no deleted feature, but some
more stringent restrictions in f2023 forbid some previously valid code.
> Please remember to keep those definitions in sync with
> gfortran.texi. */
> +#define GFC_STD_F2023_DEL (1<<13) /* Deleted in F2023. */
> #define GFC_STD_F2023 (1<<12) /* New in F2023. */
> #define GFC_STD_F2018_DEL (1<<11) /* Deleted in F2018. */
> #define GFC_STD_F2018_OBS (1<<10) /* Obsolescent in F2018. */
> @@ -41,12 +42,13 @@ along with GCC; see the file COPYING3. If not see
> * are allowed with a certain -std option. */
> #define GFC_STD_OPT_F95 (GFC_STD_F77 | GFC_STD_F95 | GFC_STD_F95_OBS \
> | GFC_STD_F2008_OBS | GFC_STD_F2018_OBS \
> - | GFC_STD_F2018_DEL)
> + | GFC_STD_F2018_DEL | GFC_STD_F2023_DEL)
> #define GFC_STD_OPT_F03 (GFC_STD_OPT_F95 | GFC_STD_F2003)
> #define GFC_STD_OPT_F08 (GFC_STD_OPT_F03 | GFC_STD_F2008)
> #define GFC_STD_OPT_F18 ((GFC_STD_OPT_F08 | GFC_STD_F2018) \
> & (~GFC_STD_F2018_DEL))
F03, F08 and F18 should have GFC_STD_F2023_DEL (and also F03 and F08
should have GFC_STD_F2018_DEL).
OK with this fixed (and the previous comments as you wish), if Steve has
no more comments.
Thanks for the patch.
On Wed, Nov 22, 2023 at 10:36:00AM +0100, Mikael Morin wrote:
>
> OK with this fixed (and the previous comments as you wish), if Steve has no
> more comments.
>
No further comments. Thanks for your patients, Harald.
As side note, I found John Reid's "What's new" document
where it is noted that there are no new obsolescent or
delete features.
https://wg5-fortran.org/N2201-N2250/N2212.pdf
Hi Steve,
On 11/22/23 19:03, Steve Kargl wrote:
> On Wed, Nov 22, 2023 at 10:36:00AM +0100, Mikael Morin wrote:
>>
>> OK with this fixed (and the previous comments as you wish), if Steve has no
>> more comments.
>>
>
> No further comments. Thanks for your patients, Harald.
>
> As side note, I found John Reid's "What's new" document
> where it is noted that there are no new obsolescent or
> delete features.
>
> https://wg5-fortran.org/N2201-N2250/N2212.pdf
>
this is good to know.
There is an older version (still referring to F202x) on the wiki:
https://gcc.gnu.org/wiki/GFortranStandards
It would be great if someone with editing permission could update
the link and point to the above.
Thanks,
Harald
@@ -4357,6 +4357,9 @@ gfc_check_null (gfc_expr *mold)
if (mold == NULL)
return true;
+ if (mold->expr_type == EXPR_NULL)
+ return true;
+
if (!variable_check (mold, 0, true))
return false;
@@ -5189,7 +5192,7 @@ is_c_interoperable (gfc_expr *expr, const char **msg, bool c_loc, bool c_f_ptr)
{
*msg = NULL;
- if (expr->expr_type == EXPR_NULL)
+ if (expr->expr_type == EXPR_NULL && expr->ts.type == BT_UNKNOWN)
{
*msg = "NULL() is not interoperable";
return false;
@@ -2387,6 +2387,8 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
gfc_component *ppc;
bool codimension = false;
gfc_array_spec *formal_as;
+ bool pointer_arg, allocatable_arg;
+ bool pre2018 = ((gfc_option.allow_std & GFC_STD_F2018) == 0);
/* If the formal arg has type BT_VOID, it's to one of the iso_c_binding
procs c_f_pointer or c_f_procpointer, and we need to accept most
@@ -2564,13 +2566,20 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
}
}
+ pointer_arg = gfc_expr_attr (actual).pointer;
+ allocatable_arg = gfc_expr_attr (actual).allocatable;
+
/* F08: 12.5.2.5 Allocatable and pointer dummy variables. However, this
is necessary also for F03, so retain error for both.
+ F2018:15.5.2.5 relaxes this constraint to same attributes.
NOTE: Other type/kind errors pre-empt this error. Since they are F03
compatible, no attempt has been made to channel to this one. */
if (UNLIMITED_POLY (formal) && !UNLIMITED_POLY (actual)
&& (CLASS_DATA (formal)->attr.allocatable
- ||CLASS_DATA (formal)->attr.class_pointer))
+ || CLASS_DATA (formal)->attr.class_pointer)
+ && (pre2018
+ || (allocatable_arg && CLASS_DATA (formal)->attr.allocatable)
+ || (pointer_arg && CLASS_DATA (formal)->attr.class_pointer)))
{
if (where)
gfc_error ("Actual argument to %qs at %L must be unlimited "
@@ -2710,7 +2719,8 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
rank_check = where != NULL && !is_elemental && formal_as
&& (formal_as->type == AS_ASSUMED_SHAPE
|| formal_as->type == AS_DEFERRED)
- && actual->expr_type != EXPR_NULL;
+ && !(actual->expr_type == EXPR_NULL
+ && actual->ts.type == BT_UNKNOWN);
/* Skip rank checks for NO_ARG_CHECK. */
if (formal->attr.ext_attr & (1 << EXT_ATTR_NO_ARG_CHECK))
@@ -3184,8 +3194,10 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
gfc_array_ref *actual_arr_ref;
gfc_array_spec *fas, *aas;
bool pointer_dummy, pointer_arg, allocatable_arg;
+ bool procptr_dummy, optional_dummy, allocatable_dummy;
bool ok = true;
+ bool pre2018 = ((gfc_option.allow_std & GFC_STD_F2018) == 0);
actual = *ap;
@@ -3296,15 +3308,66 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
&& a->expr->ts.type != BT_ASSUMED)
gfc_find_vtab (&a->expr->ts);
+ /* Checks for NULL() actual arguments without MOLD. */
+ if (a->expr->expr_type == EXPR_NULL && a->expr->ts.type == BT_UNKNOWN)
+ {
+ /* Interp J3/22-146:
+ "If the context of the reference to NULL is an <actual argument>
+ corresponding to an <assumed-rank> dummy argument, MOLD shall be
+ present." */
+ fas = (f->sym->ts.type == BT_CLASS && CLASS_DATA (f->sym)
+ ? CLASS_DATA (f->sym)->as
+ : f->sym->as);
+ if (fas && fas->type == AS_ASSUMED_RANK)
+ {
+ gfc_error ("Intrinsic %<NULL()%> without %<MOLD%> argument "
+ "at %L passed to assumed-rank dummy %qs",
+ &a->expr->where, f->sym->name);
+ ok = false;
+ goto match;
+ }
+
+ /* Asummed-length dummy argument. */
+ if (f->sym->ts.type == BT_CHARACTER
+ && !f->sym->ts.deferred
+ && f->sym->ts.u.cl
+ && f->sym->ts.u.cl->length == NULL)
+ {
+ gfc_error ("Intrinsic %<NULL()%> without %<MOLD%> argument "
+ "at %L passed to assumed-length dummy %qs",
+ &a->expr->where, f->sym->name);
+ ok = false;
+ goto match;
+ }
+ }
+
+ /* Allow passing of NULL() as disassociated pointer, procedure
+ pointer, or unallocated allocatable (F2008+) to a respective dummy
+ argument. */
+ pointer_dummy = ((f->sym->ts.type != BT_CLASS
+ && f->sym->attr.pointer)
+ || (f->sym->ts.type == BT_CLASS
+ && CLASS_DATA (f->sym)->attr.class_pointer));
+
+ procptr_dummy = ((f->sym->ts.type != BT_CLASS
+ && f->sym->attr.proc_pointer)
+ || (f->sym->ts.type == BT_CLASS
+ && CLASS_DATA (f->sym)->attr.proc_pointer));
+
+ optional_dummy = f->sym->attr.optional;
+
+ allocatable_dummy = ((f->sym->ts.type != BT_CLASS
+ && f->sym->attr.allocatable)
+ || (f->sym->ts.type == BT_CLASS
+ && CLASS_DATA (f->sym)->attr.allocatable));
+
if (a->expr->expr_type == EXPR_NULL
- && ((f->sym->ts.type != BT_CLASS && !f->sym->attr.pointer
- && (f->sym->attr.allocatable || !f->sym->attr.optional
- || (gfc_option.allow_std & GFC_STD_F2008) == 0))
- || (f->sym->ts.type == BT_CLASS
- && !CLASS_DATA (f->sym)->attr.class_pointer
- && (CLASS_DATA (f->sym)->attr.allocatable
- || !f->sym->attr.optional
- || (gfc_option.allow_std & GFC_STD_F2008) == 0))))
+ && !pointer_dummy
+ && !procptr_dummy
+ && !(optional_dummy
+ && (gfc_option.allow_std & GFC_STD_F2008) != 0)
+ && !(allocatable_dummy
+ && (gfc_option.allow_std & GFC_STD_F2008) != 0))
{
if (where
&& (!f->sym->attr.optional
@@ -3409,6 +3472,9 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
if (f->sym->ts.type == BT_CLASS)
goto skip_size_check;
+ if (a->expr->expr_type == EXPR_NULL)
+ goto skip_size_check;
+
actual_size = get_expr_storage_size (a->expr);
formal_size = get_sym_storage_size (f->sym);
if (actual_size != 0 && actual_size < formal_size
@@ -3606,6 +3672,71 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
}
}
+ /* Check conditions on allocatable and pointer dummy variables:
+
+ "The actual argument shall be polymorphic if and only if the
+ associated dummy argument is polymorphic, and either both the
+ actual and dummy arguments shall be unlimited polymorphic, or the
+ declared type of the actual argument shall be the same as the
+ declared type of the dummy argument."
+
+ with a minor difference from F2008:15.5.2.5 to F2018:15.5.2.5,
+ where the latter applies only to same (ALLOCATABLE or POINTER)
+ attributes. Note that checks related to unlimited polymorphism
+ are also done in compare_parameter(). */
+ if ((pointer_dummy || allocatable_dummy)
+ && (pointer_arg || allocatable_arg)
+ && (pre2018
+ || (pointer_dummy && pointer_arg)
+ || (allocatable_dummy && allocatable_arg))
+ && (f->sym->ts.type == BT_CLASS
+ || a->expr->ts.type == BT_CLASS))
+ {
+ if (f->sym->ts.type == BT_CLASS && a->expr->ts.type != BT_CLASS
+ && pointer_dummy)
+ {
+ if (where)
+ gfc_error ("Actual argument to %qs at %L must be a "
+ "CLASS POINTER",
+ f->sym->name, &a->expr->where);
+ ok = false;
+ goto match;
+ }
+
+ if (f->sym->ts.type != BT_CLASS && a->expr->ts.type == BT_CLASS
+ && pointer_arg)
+ {
+ if (where)
+ gfc_error ("Actual argument to %qs at %L cannot be a "
+ "CLASS POINTER",
+ f->sym->name, &a->expr->where);
+ ok = false;
+ goto match;
+ }
+
+ if (f->sym->ts.type == BT_CLASS && a->expr->ts.type != BT_CLASS
+ && allocatable_dummy)
+ {
+ if (where)
+ gfc_error ("Actual argument to %qs at %L must be a "
+ "CLASS ALLOCATABLE",
+ f->sym->name, &a->expr->where);
+ ok = false;
+ goto match;
+ }
+
+ if (f->sym->ts.type != BT_CLASS && a->expr->ts.type == BT_CLASS
+ && allocatable_arg)
+ {
+ if (where)
+ gfc_error ("Actual argument to %qs at %L cannot be a "
+ "CLASS ALLOCATABLE",
+ f->sym->name, &a->expr->where);
+ ok = false;
+ goto match;
+ }
+ }
+
/* Fortran 2008, C1242. */
if (f->sym->attr.pointer && gfc_is_coindexed (a->expr))
@@ -6288,16 +6288,37 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
&& (fsym->ts.type != BT_CLASS
|| !CLASS_DATA (fsym)->attr.class_pointer))
{
- /* Pass a NULL pointer to denote an absent arg. */
- gcc_assert (fsym->attr.optional && !fsym->attr.allocatable
- && (fsym->ts.type != BT_CLASS
- || !CLASS_DATA (fsym)->attr.allocatable));
- gfc_init_se (&parmse, NULL);
- parmse.expr = null_pointer_node;
- if (arg->associated_dummy
- && gfc_dummy_arg_get_typespec (*arg->associated_dummy).type
- == BT_CHARACTER)
- parmse.string_length = build_int_cst (gfc_charlen_type_node, 0);
+ if ((fsym->ts.type != BT_CLASS
+ && fsym->attr.allocatable)
+ || (fsym->ts.type == BT_CLASS
+ && CLASS_DATA (fsym)->attr.allocatable))
+ {
+ /* Pass descriptor equivalent to an unallocated allocatable
+ actual argument. */
+ if (e->rank != 0)
+ gfc_internal_error ("gfc_conv_procedure_call() TODO: "
+ "NULL(allocatable(rank != 0))");
+ /* Scalar version below. */
+ gfc_init_se (&parmse, NULL);
+ gfc_conv_expr_reference (&parmse, e);
+ tmp = parmse.expr;
+ if (TREE_CODE (tmp) == ADDR_EXPR)
+ tmp = TREE_OPERAND (tmp, 0);
+ parmse.expr = gfc_conv_scalar_to_descriptor (&parmse, tmp,
+ fsym->attr);
+ parmse.expr = gfc_build_addr_expr (NULL_TREE, parmse.expr);
+ }
+ else
+ {
+ /* Pass a NULL pointer to denote an absent optional arg. */
+ gcc_assert (fsym->attr.optional);
+ gfc_init_se (&parmse, NULL);
+ parmse.expr = null_pointer_node;
+ if (arg->associated_dummy
+ && gfc_dummy_arg_get_typespec (*arg->associated_dummy).type
+ == BT_CHARACTER)
+ parmse.string_length = build_int_cst (gfc_charlen_type_node, 0);
+ }
}
else if (fsym && fsym->ts.type == BT_CLASS
&& e->ts.type == BT_DERIVED)
@@ -6852,7 +6873,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
we can assign it to the data field. */
if (fsym && fsym->as && fsym->as->type == AS_ASSUMED_RANK
- && fsym->ts.type != BT_CLASS && e->expr_type != EXPR_NULL)
+ && fsym->ts.type != BT_CLASS
+ && !(e->expr_type == EXPR_NULL
+ && e->ts.type == BT_UNKNOWN))
{
tmp = parmse.expr;
if (TREE_CODE (tmp) == ADDR_EXPR)