re PR fortran/57894 (min/max required actual argument missing)
2013-07-21 Tobias Burnus <burnus@net-b.de> PR fortran/57894 * check.c (min_max_args): Add keyword= check. 2013-07-21 Tobias Burnus <burnus@net-b.de> PR fortran/57894 * gfortran.dg/min_max_conformance_2.f90: New. From-SVN: r201092
This commit is contained in:
parent
8cf887352b
commit
3b833dcda5
|
@ -1,3 +1,8 @@
|
|||
2013-07-21 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/57894
|
||||
* check.c (min_max_args): Add keyword= check.
|
||||
|
||||
2013-07-17 Mikael Morin <mikael@gcc.gnu.org>
|
||||
Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
|
|
|
@ -2328,16 +2328,85 @@ gfc_check_logical (gfc_expr *a, gfc_expr *kind)
|
|||
/* Min/max family. */
|
||||
|
||||
static bool
|
||||
min_max_args (gfc_actual_arglist *arg)
|
||||
min_max_args (gfc_actual_arglist *args)
|
||||
{
|
||||
if (arg == NULL || arg->next == NULL)
|
||||
gfc_actual_arglist *arg;
|
||||
int i, j, nargs, *nlabels, nlabelless;
|
||||
bool a1 = false, a2 = false;
|
||||
|
||||
if (args == NULL || args->next == NULL)
|
||||
{
|
||||
gfc_error ("Intrinsic '%s' at %L must have at least two arguments",
|
||||
gfc_current_intrinsic, gfc_current_intrinsic_where);
|
||||
return false;
|
||||
}
|
||||
|
||||
if (!args->name)
|
||||
a1 = true;
|
||||
|
||||
if (!args->next->name)
|
||||
a2 = true;
|
||||
|
||||
nargs = 0;
|
||||
for (arg = args; arg; arg = arg->next)
|
||||
if (arg->name)
|
||||
nargs++;
|
||||
|
||||
if (nargs == 0)
|
||||
return true;
|
||||
|
||||
/* Note: Having a keywordless argument after an "arg=" is checked before. */
|
||||
nlabelless = 0;
|
||||
nlabels = XALLOCAVEC (int, nargs);
|
||||
for (arg = args, i = 0; arg; arg = arg->next, i++)
|
||||
if (arg->name)
|
||||
{
|
||||
int n;
|
||||
char *endp;
|
||||
|
||||
if (arg->name[0] != 'a' || arg->name[1] < '1' || arg->name[1] > '9')
|
||||
goto unknown;
|
||||
n = strtol (&arg->name[1], &endp, 10);
|
||||
if (endp[0] != '\0')
|
||||
goto unknown;
|
||||
if (n <= 0)
|
||||
goto unknown;
|
||||
if (n <= nlabelless)
|
||||
goto duplicate;
|
||||
nlabels[i] = n;
|
||||
if (n == 1)
|
||||
a1 = true;
|
||||
if (n == 2)
|
||||
a2 = true;
|
||||
}
|
||||
else
|
||||
nlabelless++;
|
||||
|
||||
if (!a1 || !a2)
|
||||
{
|
||||
gfc_error ("Missing '%s' argument to the %s intrinsic at %L",
|
||||
!a1 ? "a1" : "a2", gfc_current_intrinsic,
|
||||
gfc_current_intrinsic_where);
|
||||
return false;
|
||||
}
|
||||
|
||||
/* Check for duplicates. */
|
||||
for (i = 0; i < nargs; i++)
|
||||
for (j = i + 1; j < nargs; j++)
|
||||
if (nlabels[i] == nlabels[j])
|
||||
goto duplicate;
|
||||
|
||||
return true;
|
||||
|
||||
duplicate:
|
||||
gfc_error ("Duplicate argument '%s' at %L to intrinsic %s", arg->name,
|
||||
&arg->expr->where, gfc_current_intrinsic);
|
||||
return false;
|
||||
|
||||
unknown:
|
||||
gfc_error ("Unknown argument '%s' at %L to intrinsic %s", arg->name,
|
||||
&arg->expr->where, gfc_current_intrinsic);
|
||||
return false;
|
||||
}
|
||||
|
||||
|
||||
|
@ -2345,7 +2414,6 @@ static bool
|
|||
check_rest (bt type, int kind, gfc_actual_arglist *arglist)
|
||||
{
|
||||
gfc_actual_arglist *arg, *tmp;
|
||||
|
||||
gfc_expr *x;
|
||||
int m, n;
|
||||
|
||||
|
|
|
@ -1,3 +1,8 @@
|
|||
2013-07-21 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/57894
|
||||
* gfortran.dg/min_max_conformance_2.f90: New.
|
||||
|
||||
2013-07-20 Jakub Jelinek <jakub@redhat.com>
|
||||
|
||||
PR preprocessor/57620
|
||||
|
|
|
@ -0,0 +1,24 @@
|
|||
! { dg-do compile }
|
||||
!
|
||||
! PR fortran/57894
|
||||
!
|
||||
! Contributed by Vittorio Zecca
|
||||
!
|
||||
print *, max(a2=2,a65=45,a2=5) ! { dg-error "has already appeared in the current argument list" }
|
||||
print *, min(a1=2.0,a65=45.0,a2=5.0e0) ! OK
|
||||
print *, max(a2=2,a65=45,a3=5) ! { dg-error "Missing 'a1' argument to the max intrinsic" }
|
||||
print *, min(a1=2.0,a65=45.0,a3=5.0e0) ! { dg-error "Missing 'a2' argument to the min intrinsic" }
|
||||
print *, min1(2.0,a1=45.0,a2=5.0e0) ! { dg-error "Duplicate argument 'a1'" }
|
||||
|
||||
print *, max0(a1=2,a65a=45,a2=5) ! { dg-error "Unknown argument 'a65a'" }
|
||||
print *, amax0(a1=2,as65=45,a2=5) ! { dg-error "Unknown argument 'as65'" }
|
||||
print *, max1(a1=2,a2=45,5) ! { dg-error "Missing keyword name in actual argument list" }
|
||||
print *, amax1(a1=2,a3=45,a4=5) ! { dg-error "Missing 'a2' argument" }
|
||||
print *, dmax1(a1=2,a2=45,a4z=5) ! { dg-error "Unknown argument 'a4z'" }
|
||||
|
||||
print *, min0(a1=2,a65a=45,a2=5) ! { dg-error "Unknown argument 'a65a'" }
|
||||
print *, amin0(a1=2,as65=45,a2=5) ! { dg-error "Unknown argument 'as65'" }
|
||||
print *, min1(a1=2,a2=45,5) ! { dg-error "Missing keyword name in actual argument list" }
|
||||
print *, amin1(a1=2,a3=45,a4=5) ! { dg-error "Missing 'a2' argument" }
|
||||
print *, dmin1(a1=2,a2=45,a4z=5) ! { dg-error "Unknown argument 'a4z'" }
|
||||
end
|
Loading…
Reference in New Issue