Category : Miscellaneous Language Source Code
Archive   : ADATUT12.ZIP
Filename : NEXTDATE.ADA

with TEXT_IO; use TEXT_IO;
procedure NEXTDATE is
type MONTH_TYPE is
(JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG, SEP, OCT, NOV, DEC);
subtype DAY_SUBTYPE is INTEGER range 1 .. 31;
type DATE is
record
DAY : DAY_SUBTYPE;
MONTH : MONTH_TYPE;
YEAR : POSITIVE;
end record;
PASSED : BOOLEAN := TRUE;
function TOMORROW(TODAY : in DATE) return DATE is separate;

procedure DISPLAY (S : in STRING; D : in DATE) is
package INT_IO is new INTEGER_IO(INTEGER); use INT_IO;
begin
PUT(S);
PUT(D.DAY, WIDTH => 3);
PUT(" " & MONTH_TYPE'IMAGE(D.MONTH));
PUT(D.YEAR, WIDTH => 5);
NEW_LINE;
end DISPLAY;
procedure COMPARE(TODAY, RIGHT_ANSWER : in DATE) is
MY_ANSWER : DATE := TOMORROW(TODAY);
begin
if MY_ANSWER /= RIGHT_ANSWER then
DISPLAY("Today: ", TODAY);
DISPLAY("My answer: ", MY_ANSWER);
DISPLAY("Right answer:", RIGHT_ANSWER);
NEW_LINE;
PASSED := FALSE;
end if;
end COMPARE;
begin
COMPARE((12,DEC,1815), (13,DEC,1815)); -- ordinary date
COMPARE(( 3,FEB,1986), ( 4,FEB,1986)); -- ordinary date in Feb.
COMPARE((30,JUN,1981), ( 1,JUL,1981)); -- last day of 30-day month
COMPARE((30,SEP,3999), ( 1,OCT,3999)); -- last day of 30-day month
COMPARE((31,MAR,1876), ( 1,APR,1876)); -- last day of 31-day month
COMPARE((31,AUG,1984), ( 1,SEP,1984)); -- last day of 31-day month
COMPARE((31,DEC,1966), ( 1,JAN,1967)); -- last day of year
COMPARE((28,FEB,1980), (29,FEB,1980)); -- leap year
COMPARE((28,FEB,1600), (29,FEB,1600)); -- century leap year
COMPARE((28,FEB,2200), ( 1,MAR,2200)); -- century non-leap year
COMPARE((28,FEB,1982), ( 1,MAR,1982)); -- non-leap year
COMPARE((29,FEB,1980), ( 1,MAR,1980)); -- leap day in leap year
if PASSED then
PUT_LINE("Congratulations, you completed the assignment!");
end if;
end NEXTDATE;