diff --git a/gcc/cobol/UAT/failsuite.src/run_functions.at b/gcc/cobol/UAT/failsuite.src/run_functions.at index 0d2693c4f494c5e2f6a6daafaaab3d9c98efdaf2..e26b0f98abf419ae16b184771a70072fa897b9ea 100644 --- a/gcc/cobol/UAT/failsuite.src/run_functions.at +++ b/gcc/cobol/UAT/failsuite.src/run_functions.at @@ -1094,7 +1094,6 @@ AT_CLEANUP AT_SETUP([FUNCTION FORMATTED-TIME]) AT_KEYWORDS([functions]) - AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. PROGRAM-ID. prog. @@ -1156,26 +1155,26 @@ AT_DATA([prog.cob], [ *> Test with invalid/missing offset times. MOVE FUNCTION FORMATTED-TIME ( "hhmmss+hhmm", 1, 3000 ) TO str - IF str <> SPACES - OR FUNCTION EXCEPTION-STATUS <> "EC-ARGUMENT-FUNCTION" - OR FUNCTION EXCEPTION-LOCATION <> "prog; ; 60" - DISPLAY "Test 10 failed: " str END-DISPLAY - END-IF + DISPLAY "Test 10 " """" str """" + DISPLAY "Test 10 " """" FUNCTION EXCEPTION-STATUS """" + DISPLAY "Test 10 " """" FUNCTION EXCEPTION-LOCATION """" MOVE FUNCTION FORMATTED-TIME ( "hhmmss+hhmm", 1, -3000 ) TO str - IF str <> SPACES - OR FUNCTION EXCEPTION-STATUS <> "EC-ARGUMENT-FUNCTION" - OR FUNCTION EXCEPTION-LOCATION <> "prog; ; 68" - DISPLAY "Test 11 failed: " str END-DISPLAY - END-IF + DISPLAY "Test 11 " """" str """" + DISPLAY "Test 11 " """" FUNCTION EXCEPTION-STATUS """" + DISPLAY "Test 11 " """" FUNCTION EXCEPTION-LOCATION """" STOP RUN. ]) - AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], []) - +AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [Test 10 " " +Test 10 "EC-ARGUMENT-FUNCTION" +Test 10 "prog; ; prog.cob:60 " +Test 11 " " +Test 11 "EC-ARGUMENT-FUNCTION" +Test 11 "prog; ; prog.cob:66 " +], []) AT_CLEANUP diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc index b4309be5ee7226359821d4f73efa1c40fbc92d8f..e412527ecd3b3f2eabffa72e8d021472739fefb3 100644 --- a/gcc/cobol/genapi.cc +++ b/gcc/cobol/genapi.cc @@ -8933,6 +8933,7 @@ parser_intrinsic_call_4( cbl_field_t *tgt, TRACE1_REFER("parameter 4: ", ref4, "") } + store_location_stuff(function_name); gg_call(VOID, function_name, diff --git a/libgcobol/intrinsic.cc b/libgcobol/intrinsic.cc index 6928a44282ef2f47f0cfa3e30cdf38fa736bfa97..ba52da0db4df418239a7d53c05da0516865322dd 100644 --- a/libgcobol/intrinsic.cc +++ b/libgcobol/intrinsic.cc @@ -727,13 +727,18 @@ convert_to_zulu(cobol_tm &ctm) JD -= 1; seconds_past_midnight += 86400; } - else if( seconds_past_midnight > 0 ) + else if( seconds_past_midnight >= 86400 ) { JD += 1; seconds_past_midnight -= 86400; } + JD -= JD_OF_1601_01_02; populate_ctm_from_JD(ctm, JD); populate_ctm_from_double_time(ctm, seconds_past_midnight); + if( ctm.YYYY < 1601 ) + { + ctm.YYYY = ctm.MM = ctm.DD = 0; + } } static @@ -1361,7 +1366,14 @@ __gg__formatted_date( cblc_field_t *dest, // Destination string char achftime[64]; get_all_time(achftime, ctm); - ftime_replace(d, dend, format, format_end, achftime); + if( __gg__exception_code ) + { + memset(d, internal_space, dend-d); + } + else + { + ftime_replace(d, dend, format, format_end, achftime); + } } extern "C" @@ -1397,7 +1409,14 @@ __gg__formatted_datetime( cblc_field_t *dest, // Destination string char achftime[64]; get_all_time(achftime, ctm); - ftime_replace(d, dend, format, format_end, achftime); + if( __gg__exception_code ) + { + memset(d, internal_space, dend-d); + } + else + { + ftime_replace(d, dend, format, format_end, achftime); + } } extern "C" @@ -1430,7 +1449,14 @@ __gg__formatted_time( cblc_field_t *dest, // Destination string char achftime[64]; get_all_time(achftime, ctm); - ftime_replace(d, dend, format, format_end, achftime); + if( __gg__exception_code ) + { + memset(d, internal_space, dend-d); + } + else + { + ftime_replace(d, dend, format, format_end, achftime); + } } extern "C"