This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[patch,fortran] Support type real for count_rate in system_clock (PR28484)
- From: Tobias Burnus <burnus at net-b dot de>
- To: gcc-patches <gcc-patches at gcc dot gnu dot org>, "'fortran at gcc dot gnu dot org'" <fortran at gcc dot gnu dot org>
- Date: Sat, 28 Oct 2006 00:38:42 +0200
- Subject: [patch,fortran] Support type real for count_rate in system_clock (PR28484)
:ADDPATCH fortran:
This patch adds support for using a real variable for count_rate in
system_clock as allowed since Fortran 2003.
I only added support for real(4) and real(8). If needed be, one can also
add real(10) and real(16) -- and integer(16), but I don't see any need
for it.
As count_rate is currently either 1 or 100, the real versions simply
call the integer version of system_clock_{4,8}.
Tested and regression tested on x86_64-unknown-linux-gnu
Tobias
2006-10-28 Tobias Burnus <burnus@net-b.de>
PR fortran/28484
* intrinsics/system_clock.c: Renamed system_clock_4
and system_clock_8 to system_clock_4_r0 and
system_clock_8_r0; added system_clock_4_r4,
system_clock_4_r8, system_clock_8_r4,
system_clock_8_r8 for real-type count_rate.
2006-10-28 Tobias Burnus <burnus@net-b.de>
PR fortran/28484
* check.c (gfc_check_system_clock): Accept real-type count_rate.
* iresolve.c (gfc_resolve_system_clock): Support real-type count_rate.
2006-10-28 Tobias Burnus <burnus@net-b.de>
PR fortran/28484
* gfortran.dg/time_checks.f90: Added.
Index: libgfortran/intrinsics/system_clock.c
===================================================================
--- libgfortran/intrinsics/system_clock.c (Revision 118083)
+++ libgfortran/intrinsics/system_clock.c (Arbeitskopie)
@@ -44,20 +44,32 @@
#endif
-extern void system_clock_4 (GFC_INTEGER_4 *, GFC_INTEGER_4 *, GFC_INTEGER_4 *);
-export_proto(system_clock_4);
+extern void system_clock_4_r0 (GFC_INTEGER_4 *, GFC_INTEGER_4 *, GFC_INTEGER_4 *);
+export_proto(system_clock_4_r0);
-extern void system_clock_8 (GFC_INTEGER_8 *, GFC_INTEGER_8 *, GFC_INTEGER_8 *);
-export_proto(system_clock_8);
+extern void system_clock_4_r4 (GFC_INTEGER_4 *, GFC_REAL_4 *, GFC_INTEGER_4 *);
+export_proto(system_clock_4_r4);
+extern void system_clock_4_r8 (GFC_INTEGER_4 *, GFC_REAL_8 *, GFC_INTEGER_4 *);
+export_proto(system_clock_4_r8);
+extern void system_clock_8_r0 (GFC_INTEGER_8 *, GFC_INTEGER_8 *, GFC_INTEGER_8 *);
+export_proto(system_clock_8_r0);
+
+extern void system_clock_8_r4 (GFC_INTEGER_8 *, GFC_REAL_4 *, GFC_INTEGER_8 *);
+export_proto(system_clock_8_r4);
+
+extern void system_clock_8_r8 (GFC_INTEGER_8 *, GFC_REAL_8 *, GFC_INTEGER_8 *);
+export_proto(system_clock_8_r8);
+
+
/* prefix(system_clock_4) is the INTEGER(4) version of the SYSTEM_CLOCK
intrinsic subroutine. It returns the number of clock ticks for the current
system time, the number of ticks per second, and the maximum possible value
for COUNT. On the first call to SYSTEM_CLOCK, COUNT is set to zero. */
void
-system_clock_4(GFC_INTEGER_4 *count, GFC_INTEGER_4 *count_rate,
+system_clock_4_r0(GFC_INTEGER_4 *count, GFC_INTEGER_4 *count_rate,
GFC_INTEGER_4 *count_max)
{
GFC_INTEGER_4 cnt;
@@ -120,7 +132,7 @@
/* INTEGER(8) version of the above routine. */
void
-system_clock_8 (GFC_INTEGER_8 *count, GFC_INTEGER_8 *count_rate,
+system_clock_8_r0 (GFC_INTEGER_8 *count, GFC_INTEGER_8 *count_rate,
GFC_INTEGER_8 *count_max)
{
GFC_INTEGER_8 cnt;
@@ -201,3 +213,43 @@
if (count_max != NULL)
*count_max = mx;
}
+
+
+/* version with real count_rate; as we define TCK as integer,
+ we simply call the integer versions */
+
+void
+system_clock_4_r4(GFC_INTEGER_4 *count, GFC_REAL_4 *count_rate,
+ GFC_INTEGER_4 *count_max)
+{
+ GFC_INTEGER_4 cnt_rate;
+ system_clock_4_r0(count,&cnt_rate,count_max);
+ *count_rate = cnt_rate;
+}
+
+void
+system_clock_4_r8(GFC_INTEGER_4 *count, GFC_REAL_8 *count_rate,
+ GFC_INTEGER_4 *count_max)
+{
+ GFC_INTEGER_4 cnt_rate;
+ system_clock_4_r0(count,&cnt_rate,count_max);
+ *count_rate = cnt_rate;
+}
+
+void
+system_clock_8_r4(GFC_INTEGER_8 *count, GFC_REAL_4 *count_rate,
+ GFC_INTEGER_8 *count_max)
+{
+ GFC_INTEGER_8 cnt_rate;
+ system_clock_8_r0(count,&cnt_rate,count_max);
+ *count_rate = cnt_rate;
+}
+
+void
+system_clock_8_r8(GFC_INTEGER_8 *count, GFC_REAL_8 *count_rate,
+ GFC_INTEGER_8 *count_max)
+{
+ GFC_INTEGER_8 cnt_rate;
+ system_clock_8_r0(count,&cnt_rate,count_max);
+ *count_rate = cnt_rate;
+}
Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c (Revision 118083)
+++ gcc/fortran/check.c (Arbeitskopie)
@@ -2872,13 +2872,34 @@
if (scalar_check (count_rate, 1) == FAILURE)
return FAILURE;
- if (type_check (count_rate, 1, BT_INTEGER) == FAILURE)
- return FAILURE;
+ if (count_rate->ts.type == BT_REAL)
+ {
+ if (gfc_notify_std (GFC_STD_F2003,
+ "'%s' argument of '%s' intrinsic at %L must be %s",
+ gfc_current_intrinsic_arg[1], gfc_current_intrinsic,
+ &count_rate->where, gfc_basic_typename (BT_INTEGER))
+ == FAILURE)
+ return FAILURE;
+ }
+ else if (count_rate->ts.type != BT_INTEGER)
+ {
+ if (gfc_notify_std (GFC_STD_F2003,
+ "'%s' argument of '%s' intrinsic at %L must be %s",
+ gfc_current_intrinsic_arg[1], gfc_current_intrinsic,
+ &count_rate->where, gfc_basic_typename (BT_INTEGER))
+ != FAILURE)
+ gfc_error ("'%s' argument of '%s' intrinsic at %L must be %s or %s",
+ gfc_current_intrinsic_arg[1], gfc_current_intrinsic,
+ &count_rate->where, gfc_basic_typename (BT_INTEGER),
+ gfc_basic_typename (BT_REAL));
+ return FAILURE;
+ }
+
if (variable_check (count_rate, 1) == FAILURE)
return FAILURE;
- if (count != NULL
+ if (count != NULL && count_rate->ts.type == BT_INTEGER
&& same_type_check (count, 0, count_rate, 1) == FAILURE)
return FAILURE;
@@ -2899,7 +2920,7 @@
&& same_type_check (count, 0, count_max, 2) == FAILURE)
return FAILURE;
- if (count_rate != NULL
+ if (count_rate != NULL && count_rate->ts.type == BT_INTEGER
&& same_type_check (count_rate, 1, count_max, 2) == FAILURE)
return FAILURE;
}
Index: gcc/fortran/iresolve.c
===================================================================
--- gcc/fortran/iresolve.c (Revision 118083)
+++ gcc/fortran/iresolve.c (Arbeitskopie)
@@ -2730,17 +2730,36 @@
{
const char *name;
int kind;
+ int realkind;
- if (c->ext.actual->expr != NULL)
+
+ /* Check first the integer kind */
+ if (c->ext.actual->expr != NULL
+ && c->ext.actual->expr->ts.type == BT_INTEGER)
kind = c->ext.actual->expr->ts.kind;
- else if (c->ext.actual->next->expr != NULL)
+ else if (c->ext.actual->next->expr != NULL
+ && c->ext.actual->next->expr->ts.type == BT_INTEGER)
kind = c->ext.actual->next->expr->ts.kind;
- else if (c->ext.actual->next->next->expr != NULL)
+ else if (c->ext.actual->next->next->expr != NULL
+ && c->ext.actual->next->next->expr->ts.type == BT_INTEGER)
kind = c->ext.actual->next->next->expr->ts.kind;
else
kind = gfc_default_integer_kind;
- name = gfc_get_string (PREFIX("system_clock_%d"), kind);
+ /* Check now the real kind (if any) */
+ if (c->ext.actual->expr != NULL
+ && c->ext.actual->expr->ts.type == BT_REAL)
+ realkind = c->ext.actual->expr->ts.kind;
+ else if (c->ext.actual->next->expr != NULL
+ && c->ext.actual->next->expr->ts.type == BT_REAL)
+ realkind = c->ext.actual->next->expr->ts.kind;
+ else if (c->ext.actual->next->next->expr != NULL
+ && c->ext.actual->next->next->expr->ts.type == BT_REAL)
+ realkind = c->ext.actual->next->next->expr->ts.kind;
+ else
+ realkind = 0;
+
+ name = gfc_get_string (PREFIX("system_clock_%d_r%d"), kind,realkind);
c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
}
--- /dev/null 2006-10-21 23:34:46.000000000 +0200
+++ gcc/testsuite/gfortran.dg/time_checks.f90 2006-10-28 00:13:14.000000000 +0200
@@ -0,0 +1,36 @@
+! { dg-do run }
+! Some simple compile & run checks for time-related routines
+! PR fortran/28484 for system_clock with type real count_rate
+program time_checks
+ implicit none
+ integer(4) :: i4_1, i4_2, i4_3
+ integer(8) :: i8_1, i8_2, i8_3
+ real(4) :: r4
+ real(8) :: r8
+ integer :: int(8)
+
+ ! Check system_time first (real count_rate is Fortran 2003)
+ ! (test assume that a clock is available)
+ call system_clock(count_rate=i4_1, count=i4_2,count_max=i4_3)
+ if(i4_1 <= 0 .or. i4_2 < 0 .or. i4_3 <= 0) call abort()
+ call system_clock(count_rate=i8_1,count=i8_2,count_max=i8_3)
+ if(i4_1 <= 0 .or. i8_2 < 0 .or. i8_3 <= 0) call abort()
+ call system_clock(count_rate=r4, count=i4_2,count_max=i4_3)
+ if(r4 <= 0 .or. i4_2 < 0 .or. i4_3 <= 0) call abort()
+ call system_clock(count_rate=r8, count=i4_2,count_max=i4_3)
+ if(r8 <= 0 .or. i4_2 < 0 .or. i4_3 <= 0) call abort()
+ call system_clock(count_rate=r4, count=i8_2,count_max=i8_3)
+ if(r4 <= 0 .or. i8_2 < 0 .or. i8_3 <= 0) call abort()
+ call system_clock(count_rate=r8, count=i8_2,count_max=i8_3)
+ if(r8 <= 0 .or. i8_2 < 0 .or. i8_3 <= 0) call abort()
+ call system_clock()
+
+ ! Check now cpu_time
+ call cpu_time(r4)
+ if(r4 < 0) call abort()
+ call cpu_time(r8)
+ if(r8 < 0) call abort()
+
+ ! Check date_and_time
+ call date_and_time(values=int)
+end program time_checks