PR modula2/110779 SysClock can not read the clock

This patch completes the implementation of the ISO module
SysClock.mod.  Three new testcases are provided.  wrapclock.{cc,def}
are new support files providing access to clock_settime, clock_gettime
and glibc timezone variables.

gcc/m2/ChangeLog:

	PR modula2/110779
	* gm2-libs-iso/SysClock.mod: Re-implement using wrapclock.
	* gm2-libs-iso/wrapclock.def: New file.

libgm2/ChangeLog:

	PR modula2/110779
	* config.h.in: Regenerate.
	* configure: Regenerate.
	* configure.ac (GM2_CHECK_LIB): Check for clock_gettime
	and clock_settime.
	* libm2iso/Makefile.am (M2DEFS): Add wrapclock.def.
	* libm2iso/Makefile.in: Regenerate.
	* libm2iso/wraptime.cc: Replace HAVE_TIMEVAL with
	HAVE_STRUCT_TIMEVAL.
	* libm2iso/wrapclock.cc: New file.

gcc/testsuite/ChangeLog:

	PR modula2/110779
	* gm2/iso/run/pass/m2date.mod: New test.
	* gm2/iso/run/pass/testclock.mod: New test.
	* gm2/iso/run/pass/testclock2.mod: New test.

Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>

5 files changed, 419 insertions, 100 deletions

diff --git a/gcc/m2/gm2-libs-iso/SysClock.mod b/gcc/m2/gm2-libs-iso/SysClock.mod
index e894489..60261f2 100644
--- a/gcc/m2/gm2-libs-iso/SysClock.mod
+++ b/gcc/m2/gm2-libs-iso/SysClock.mod
@@ -26,17 +26,16 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 
 IMPLEMENTATION MODULE SysClock ;
 
-FROM wraptime IMPORT timeval, timezone, tm,
-                     InitTimezone, InitTimeval,
-                     InitTM, KillTM,
-                     gettimeofday, settimeofday, GetFractions,
-                     localtime_r, GetSummerTime, GetDST,
-                     KillTimezone, KillTimeval, GetYear,
-                     GetMonth, GetDay, GetHour, GetMinute,
-                     GetSecond, SetTimeval, SetTimezone ;
+FROM wrapclock IMPORT timespec, timezone, isdst, InitTimespec, KillTimespec,
+                      GetTimespec, SetTimespec, GetTimeRealtime, SetTimeRealtime ;
+
+FROM libc IMPORT printf ;
 
 IMPORT Args ;
 
+CONST
+   Debugging = FALSE ;
+
 VAR
    canget,
    canset,
@@ -50,25 +49,23 @@ VAR
 
 PROCEDURE determineAccess ;
 VAR
-   tv: timeval ;
-   tz: timezone ;
+   ts: timespec ;
 BEGIN
-   tz := InitTimezone () ;
-   tv := InitTimeval () ;
-   canget := gettimeofday (tv, tz) = 0 ;
-   canset := canget AND (settimeofday (tv, tz) = 0) ;
-   tz := KillTimezone (tz) ;
-   tv := KillTimeval (tv)
+   IF NOT known
+   THEN
+      ts := InitTimespec () ;
+      canget := GetTimeRealtime (ts) = 0 ;
+      canset := canget AND (SetTimeRealtime (ts) = 0) ;
+      ts := KillTimespec (ts) ;
+      known := TRUE
+   END
 END determineAccess ;
 
 
 PROCEDURE CanGetClock () : BOOLEAN ;
 (* Tests if the clock can be read *)
 BEGIN
-   IF NOT known
-   THEN
-      determineAccess
-   END ;
+   determineAccess ;
    RETURN canget
 END CanGetClock ;
 
@@ -76,10 +73,7 @@ END CanGetClock ;
 PROCEDURE CanSetClock () : BOOLEAN ;
 (* Tests if the clock can be set *)
 BEGIN
-   IF NOT known
-   THEN
-      determineAccess
-   END ;
+   determineAccess ;
    RETURN canset
 END CanSetClock ;
 
@@ -114,42 +108,107 @@ BEGIN
 END IsValidDateTime ;
 
 
+(*
+   DivMod - returns seconds MOD modulus.  It also divides seconds by modulus.
+*)
+
+PROCEDURE DivMod (VAR seconds: LONGCARD; modulus: LONGCARD) : LONGCARD ;
+VAR
+   result: LONGCARD ;
+BEGIN
+   result := seconds MOD modulus ;
+   seconds := seconds DIV modulus ;
+   RETURN result
+END DivMod ;
+
+
+(*
+   daysInYear - return the number of days in year up to month/day.
+*)
+
+PROCEDURE daysInYear (day, month, year: LONGCARD) : LONGCARD ;
+BEGIN
+   WHILE month > 1 DO
+      INC (day, daysInMonth (year, month)) ;
+      DEC (month)
+   END ;
+   RETURN day
+END daysInYear ;
+
+
+(*
+   ExtractDate - extracts the year, month, day from days.
+*)
+
+PROCEDURE ExtractDate (days: LONGCARD;
+                       VAR year: CARDINAL; VAR month: Month; VAR day: Day) ;
+VAR
+   testMonth,
+   testYear : CARDINAL ;
+   testDays : LONGCARD ;
+BEGIN
+   testYear := 1970 ;
+   LOOP
+      testDays := daysInYear (31, 12, testYear) ;
+      IF days < testDays
+      THEN
+         year := testYear ;
+         testMonth := 1 ;
+         LOOP
+            testDays := daysInMonth (year, testMonth) ;
+            IF days < testDays
+            THEN
+               day := VAL (Day, days) + MIN (Day) ;
+               month := VAL (Month, testMonth) ;
+               RETURN
+            END ;
+            DEC (days, testDays) ;
+            INC (testMonth)
+         END
+      ELSE
+         DEC (days, testDays) ;
+         INC (testYear)
+      END
+   END
+END ExtractDate ;
+
+
 PROCEDURE GetClock (VAR userData: DateTime) ;
 (* Assigns local date and time of the day to userData *)
 VAR
-   m : tm ;
-   tv: timeval ;
-   tz: timezone ;
+   ts       : timespec ;
+   nano, sec: LONGCARD ;
+   offset   : LONGINT ;
 BEGIN
    IF CanGetClock ()
    THEN
-      tv := InitTimeval () ;
-      tz := InitTimezone () ;
-      IF gettimeofday (tv, tz)=0
+      ts := InitTimespec () ;
+      IF GetTimeRealtime (ts) = 0
       THEN
-         m := InitTM () ;
-         (* m := localtime_r (tv, m) ; *)
-         WITH userData DO
-         (*
-            year := GetYear (m) ;
-         *)
-            month := Args.Narg () (* GetMonth (m) *) (* + 1 *) ;
-            (*
-            day := GetDay (m) ;
-            hour := GetHour (m) ;
-            minute := GetMinute (m) ;
-            second := GetSecond (m) ;
-            fractions := GetFractions (tv) ;
-            zone := GetDST (tz) ;
-            summerTimeFlag := GetSummerTime (tz)
-            *)
+         GetTimespec (ts, sec, nano) ;
+         offset := timezone () ;
+         IF Debugging
+         THEN
+            printf ("getclock = %ld\n", sec)
+         END ;
+         sec := VAL (LONGINT, sec) + offset ;
+         IF Debugging
+         THEN
+            printf ("getclock = %ld\n", sec)
          END ;
-         m := KillTM (m)
+         WITH userData DO
+            second := VAL (Sec, DivMod (sec, MAX (Sec) + 1)) ;
+            minute := VAL (Min, DivMod (sec, MAX (Min) + 1)) ;
+            hour := VAL (Hour, DivMod (sec, MAX (Hour) + 1)) ;
+            ExtractDate (sec, year, month, day) ;
+            fractions := nano DIV ((1000 * 1000 * 1000) DIV maxSecondParts) ;
+            zone := - (offset DIV 60) ;
+            summerTimeFlag := (isdst () = 1)
+         END
       ELSE
          HALT
       END ;
-      tv := KillTimeval (tv) ;
-      tz := KillTimezone (tz)
+      ts := KillTimespec (ts)
    END
 END GetClock ;
 
@@ -158,7 +217,7 @@ END GetClock ;
    daysInMonth - returns how many days there are in a month.
 *)
 
-PROCEDURE daysInMonth (year, month: CARDINAL) : CARDINAL ;
+PROCEDURE daysInMonth (year, month: CARDINAL) : LONGCARD ;
 BEGIN
    CASE month OF
 
@@ -186,76 +245,73 @@ END daysInMonth ;
 
 
 (*
-   dayInYear -
+   totalYear - return the sum of all days prior to year from the epoch.
 *)
 
-PROCEDURE dayInYear (day, month, year: CARDINAL) : CARDINAL ;
+PROCEDURE totalYear (year: LONGCARD) : LONGCARD ;
+VAR
+   lastYear,
+   result  : LONGCARD ;
 BEGIN
-   WHILE month > 1 DO
-      INC (day, daysInMonth (year, month)) ;
-      DEC (month)
+   lastYear := 1970 ;
+   result := 0 ;
+   WHILE lastYear < year DO
+      INC (result, daysInYear (31, 12, lastYear)) ;
+      INC (lastYear)
    END ;
-   RETURN day
-END dayInYear ;
+   RETURN result
+END totalYear ;
 
 
 (*
-   dayInWeek -
+   totalSeconds - returns the total seconds
 *)
 
-PROCEDURE dayInWeek (day, month, year: CARDINAL) : CARDINAL ;
-CONST
-   janFirst1970 = 5 ;   (* thursday *)
+PROCEDURE totalSeconds (second, minute, hour,
+                        day, month, year: LONGCARD) : LONGCARD ;
 VAR
-   yearOffset: CARDINAL ;  (* days since Jan 1st 1970 *)
+   result: LONGCARD ;
 BEGIN
-   yearOffset := janFirst1970 ;
-   WHILE year > 1970 DO
-      DEC (year) ;
-      INC (yearOffset, dayInYear (31, 12, year))
-   END ;
-   INC (yearOffset, dayInYear (day, month, year)) ;
-   RETURN yearOffset MOD 7
-END dayInWeek ;
+   result := second
+             + minute * (MAX (Sec) + 1)
+             + hour * ((MAX (Min) + 1) * (MAX (Sec) + 1))
+             + ((daysInYear (day, month, year) + totalYear (year))
+                * ((MAX (Hour) + 1) * ((MAX (Min) + 1) * (MAX (Sec) + 1)))) ;
+   RETURN result
+END totalSeconds ;
 
 
 PROCEDURE SetClock (userData: DateTime);
-(* Sets the system time clock to the given local date and
-   time *)
 VAR
-   tv: timeval ;
-   tz: timezone ;
+   ts       : timespec ;
+   nano, sec: LONGCARD ;
+   offset   : LONGINT ;
 BEGIN
+   IF Debugging
+   THEN
+      sec := totalSeconds (userData.second, userData.minute, userData.hour,
+                           VAL (CARDINAL, userData.day) - MIN (Day),
+                           userData.month, userData.year) ;
+      printf ("setclock = %ld\n", sec);
+      offset := timezone () ;
+      sec := VAL (LONGINT, sec) - offset ;
+      printf ("setclock = %ld\n", sec);
+   END ;
    IF CanSetClock ()
    THEN
-      tv := InitTimeval () ;
-      tz := InitTimezone () ;
-      IF gettimeofday (tv, tz) = 0
+      ts := InitTimespec () ;
+      nano := VAL (LONGCARD, userData.fractions * 1000) ;
+      sec := totalSeconds (userData.second, userData.minute, userData.hour,
+                           VAL (CARDINAL, userData.day) - MIN (Day),
+                           userData.month, userData.year) ;
+      offset := timezone () ;
+      sec := VAL (LONGINT, sec) - offset ;
+      SetTimespec (ts, sec, nano) ;
+      IF SetTimeRealtime (ts) # 0
       THEN
-         (* fill in as many of tv, tz fields from userData as we can *)
-         WITH userData DO
-            IF summerTimeFlag
-            THEN
-               SetTimeval (tv, second, minute, hour, day, month, year,
-                           dayInYear(day, month, year),
-                           dayInWeek(day, month, year),
-                           1) ;
-               SetTimezone (tz, 1, zone)
-            ELSE
-               SetTimeval (tv, second, minute, hour, day, month, year,
-                           dayInYear(day, month, year),
-                           dayInWeek(day, month, year),
-                           0) ;
-               SetTimezone (tz, 0, zone)
-            END ;
-            IF settimeofday (tv, tz)#0
-            THEN
-               (* error, which we ignore *)
-            END
-         END
+         HALT
       END ;
-      tv := KillTimeval (tv) ;
-      tz := KillTimezone (tz)
+      ts := KillTimespec (ts)
    END
 END SetClock ;
 
diff --git a/gcc/m2/gm2-libs-iso/wrapclock.def b/gcc/m2/gm2-libs-iso/wrapclock.def
new file mode 100644
index 0000000..9e1644b
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/wrapclock.def
@@ -0,0 +1,125 @@
+(* wrapclock.def provides access to clock primitives.
+
+Copyright (C) 2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaiusmod2@gmail.com>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
+<http://www.gnu.org/licenses/>.  *)
+
+DEFINITION MODULE wrapclock ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+TYPE
+   timespec = ADDRESS ;
+
+
+(*
+   timezone - return the glibc timezone value.
+              This contains the difference between UTC and the latest
+              local standard time, in seconds west of UTC.
+*)
+
+PROCEDURE timezone () : LONGINT ;
+
+
+(*
+   daylight - return the glibc daylight value.
+              This variable has a nonzero value if Daylight Saving
+              Time rules apply.
+              A nonzero value does not necessarily mean that Daylight
+              Saving Time is now in effect; it means only that Daylight
+              Saving Time is sometimes in effect.
+*)
+
+PROCEDURE daylight () : INTEGER ;
+
+
+(*
+   isdst - returns 1 if daylight saving time is currently in effect and
+           returns 0 if it is not.
+*)
+
+PROCEDURE isdst () : INTEGER ;
+
+
+(*
+   tzname - returns the string associated with the local timezone.
+            The daylight value is 0 or 1.  The value 0 returns the non
+            daylight saving timezone string and the value of 1 returns
+            the daylight saving timezone string.
+*)
+
+PROCEDURE tzname (daylight: INTEGER) : ADDRESS ;
+
+
+(*
+   InitTimespec - returns a newly created opaque type.
+*)
+
+PROCEDURE InitTimespec () : timespec ;
+
+
+(*
+   KillTimespec - deallocates the memory associated with an
+                  opaque type.
+*)
+
+PROCEDURE KillTimespec (tv: timespec) : timespec ;
+
+
+(*
+   GetTimespec - retrieves the number of seconds and nanoseconds
+                 from the timespec.
+*)
+
+PROCEDURE GetTimespec (ts: timespec; VAR sec, nano: LONGCARD) ;
+
+
+(*
+   SetTimespec - sets the number of seconds and nanoseconds
+                 into timespec.
+*)
+
+PROCEDURE SetTimespec (ts: timespec; sec, nano: LONGCARD) ;
+
+
+(*
+   GetTimeRealtime - performs return gettime (CLOCK_REALTIME, ts).
+                     gettime returns 0 on success and -1 on failure.
+                     If the underlying system does not have gettime
+                     then GetTimeRealtime returns 1.
+*)
+
+PROCEDURE GetTimeRealtime (ts: timespec) : INTEGER ;
+
+
+(*
+   SetTimeRealtime - performs return settime (CLOCK_REALTIME, ts).
+                     gettime returns 0 on success and -1 on failure.
+                     If the underlying system does not have gettime
+                     then SetTimeRealtime returns 1.
+*)
+
+PROCEDURE SetTimeRealtime (ts: timespec) : INTEGER ;
+
+
+END wrapclock.
diff --git a/gcc/testsuite/gm2/iso/run/pass/m2date.mod b/gcc/testsuite/gm2/iso/run/pass/m2date.mod
new file mode 100644
index 0000000..1d8b595
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/m2date.mod
@@ -0,0 +1,101 @@
+MODULE m2date ;
+
+IMPORT SysClock, STextIO, SWholeIO ;
+FROM SysClock IMPORT DateTime, GetClock ;
+FROM wrapclock IMPORT tzname ;
+FROM ASCII IMPORT nul ;
+
+
+TYPE
+   Name = ARRAY [0..3] OF CHAR ;
+   DayArray = ARRAY [0..6] OF Name ;
+   MonthArray = ARRAY [0..11] OF Name ;
+
+CONST
+   Debugging = FALSE ;
+   DayName = DayArray { "Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun" } ;
+   MonthName = MonthArray { "Dec", "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov" } ;
+
+
+
+PROCEDURE WriteTZ (daylight: CARDINAL) ;
+VAR
+   tz : ARRAY [0..10] OF CHAR ;
+   ptr: POINTER TO CHAR ;
+   i  : CARDINAL ;
+BEGIN
+   ptr := tzname (daylight) ;
+   i := 0 ;
+   WHILE (i <= HIGH (tz)) AND (ptr^ # nul) DO
+      tz[i] := ptr^ ;
+      INC (ptr) ;
+      INC (i)
+   END ;
+   IF i < HIGH (tz)
+   THEN
+      tz[i] := nul
+   END ;
+   STextIO.WriteString (tz)
+END WriteTZ ;
+
+
+PROCEDURE WriteNum (num: CARDINAL) ;
+BEGIN
+   IF num < 10
+   THEN
+      STextIO.WriteString ("0")
+   END ;
+   SWholeIO.WriteCard (num, 0)
+END WriteNum ;
+
+
+VAR
+   dt: DateTime ;
+BEGIN
+   IF SysClock.CanGetClock ()
+   THEN
+      GetClock (dt) ;
+      IF Debugging
+      THEN
+         STextIO.WriteString ("success we can get the clock") ; STextIO.WriteLn ;
+         STextIO.WriteString (" year     : ") ; SWholeIO.WriteCard (dt.year, 4) ;
+         STextIO.WriteLn ;
+         STextIO.WriteString (" month    : ") ; SWholeIO.WriteCard (dt.month, 4) ;
+         STextIO.WriteLn ;
+         STextIO.WriteString (" day      : ") ; SWholeIO.WriteCard (dt.day, 4) ;
+         STextIO.WriteLn ;
+         STextIO.WriteString (" hour     : ") ; SWholeIO.WriteCard (dt.hour, 4) ;
+         STextIO.WriteLn ;
+         STextIO.WriteString (" minute   : ") ; SWholeIO.WriteCard (dt.minute, 4) ;
+         STextIO.WriteLn ;
+         STextIO.WriteString (" second   : ") ; SWholeIO.WriteCard (dt.second, 4) ;
+         STextIO.WriteLn ;
+         STextIO.WriteString (" fractions: ") ; SWholeIO.WriteCard (dt.fractions, 10) ;
+         STextIO.WriteLn ;
+         STextIO.WriteString (" zone     : ") ; SWholeIO.WriteCard (dt.zone, 10) ;
+         STextIO.WriteLn
+      END ;
+      STextIO.WriteString (DayName[dt.day MOD 7]) ;
+      STextIO.WriteString (" ") ;
+      SWholeIO.WriteCard (dt.day, 2) ;
+      STextIO.WriteString (" ") ;
+      STextIO.WriteString (MonthName[dt.month MOD 12]) ;
+      STextIO.WriteString (" ") ;
+      WriteNum (dt.hour) ; STextIO.WriteString (":") ;
+      WriteNum (dt.minute) ; STextIO.WriteString (":") ;
+      WriteNum (dt.second) ; STextIO.WriteString (" ") ;
+      IF dt.summerTimeFlag
+      THEN
+         WriteTZ (1)
+      ELSE
+         WriteTZ (0)
+      END ;
+      STextIO.WriteString (" ") ;
+      SWholeIO.WriteCard (dt.year, 0) ;
+      STextIO.WriteLn
+   ELSE
+      STextIO.WriteString ("unable to get the clock") ;
+      STextIO.WriteLn ;
+      HALT (1)
+   END
+END m2date.
diff --git a/gcc/testsuite/gm2/iso/run/pass/testclock.mod b/gcc/testsuite/gm2/iso/run/pass/testclock.mod
new file mode 100644
index 0000000..a546eaf
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/testclock.mod
@@ -0,0 +1,15 @@
+MODULE testclock ;
+
+IMPORT SysClock, STextIO ;
+
+BEGIN
+   IF SysClock.CanGetClock ()
+   THEN
+      STextIO.WriteString ("success we can get the clock") ;
+      STextIO.WriteLn
+   ELSE
+      STextIO.WriteString ("unable to get the clock") ;
+      STextIO.WriteLn ;
+      HALT (1)
+   END
+END testclock.
diff --git a/gcc/testsuite/gm2/iso/run/pass/testclock2.mod b/gcc/testsuite/gm2/iso/run/pass/testclock2.mod
new file mode 100644
index 0000000..c80faff
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/testclock2.mod
@@ -0,0 +1,22 @@
+MODULE testclock2 ;
+
+IMPORT SysClock, STextIO ;
+
+VAR
+   dt: SysClock.DateTime ;
+BEGIN
+   IF SysClock.CanGetClock ()
+   THEN
+      SysClock.GetClock (dt) ;
+      IF SysClock.CanSetClock ()
+      THEN
+         STextIO.WriteString ("success we can set the clock") ; STextIO.WriteLn ;
+         SysClock.SetClock (dt)
+      ELSE
+         STextIO.WriteString ("unable to set the clock") ; STextIO.WriteLn
+      END
+      ; SysClock.SetClock (dt)
+   ELSE
+      STextIO.WriteString ("unable to get the clock") ; STextIO.WriteLn
+   END
+END testclock2.