Browse Source

* synchronized with trunk

git-svn-id: branches/unicodekvm@48655 -
nickysn 4 years ago
parent
commit
3799569da0

+ 1 - 0
.gitattributes

@@ -16104,6 +16104,7 @@ tests/test/units/cocoaall/tw36362.pp svneol=native#text/plain
 tests/test/units/cpu/tcpu1.pp svneol=native#text/pascal
 tests/test/units/crt/tcrt.pp svneol=native#text/plain
 tests/test/units/crt/tctrlc.pp svneol=native#text/plain
+tests/test/units/dateutil/test_scandatetime_ampm.pas svneol=native#text/plain
 tests/test/units/dateutil/testscandatetime.pas svneol=native#text/plain
 tests/test/units/dateutil/tunitdt1.pp svneol=native#text/pascal
 tests/test/units/dos/hello.pp svneol=native#text/plain

+ 0 - 1
compiler/arm/aasmcpu.pas

@@ -2204,7 +2204,6 @@ implementation
             IF_ARMv4,
             IF_ARMv4,
             IF_ARMv4T or IF_ARMv4,
-            IF_ARMv4T or IF_ARMv4 or IF_ARMv5,
             IF_ARMv4T or IF_ARMv4 or IF_ARMv5 or IF_ARMv5T,
             IF_ARMv4T or IF_ARMv4 or IF_ARMv5 or IF_ARMv5T or IF_ARMv5TE,
             IF_ARMv4T or IF_ARMv4 or IF_ARMv5 or IF_ARMv5T or IF_ARMv5TE or IF_ARMv5TEJ,

+ 0 - 1
compiler/arm/agarmgas.pas

@@ -64,7 +64,6 @@ unit agarmgas;
         'armv3',
         'armv4',
         'armv4t',
-        'armv5',
         'armv5t',
         'armv5te',
         'armv5tej',

+ 6 - 7
compiler/arm/cgcpu.pas

@@ -294,7 +294,8 @@ unit cgcpu;
           rg[R_INTREGISTER]:=trgintcpu.create(R_INTREGISTER,R_SUBWHOLE,
               [RS_R0,RS_R1,RS_R2,RS_R3,RS_R9,RS_R12,RS_R4,RS_R5,RS_R6,RS_R8,
                RS_R10,RS_R11,RS_R14],first_int_imreg,[]);
-        rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBNONE,
+        if FPUARM_HAS_FPA in fpu_capabilities[current_settings.fputype] then
+          rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBNONE,
             [RS_F0,RS_F1,RS_F2,RS_F3,RS_F4,RS_F5,RS_F6,RS_F7],first_fpu_imreg,[]);
         { The register allocator currently cannot deal with multiple
           non-overlapping subregs per register, so we can only use
@@ -306,7 +307,7 @@ unit cgcpu;
                RS_D16,RS_D17,RS_D18,RS_D19,RS_D20,RS_D21,RS_D22,RS_D23,RS_D24,RS_D25,RS_D26,RS_D27,RS_D28,RS_D29,RS_D30,RS_D31,
                RS_D8,RS_D9,RS_D10,RS_D11,RS_D12,RS_D13,RS_D14,RS_D15
               ],first_mm_imreg,[])
-        else
+        else if FPUARM_HAS_VFP_EXTENSION in fpu_capabilities[current_settings.fputype] then
           rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBFD,
               [RS_D0,RS_D1,RS_D2,RS_D3,RS_D4,RS_D5,RS_D6,RS_D7,RS_D8,RS_D9,RS_D10,RS_D11,RS_D12,RS_D13,RS_D14,RS_D15],first_mm_imreg,[]);
       end;
@@ -4329,7 +4330,8 @@ unit cgcpu;
           rg[R_INTREGISTER]:=trgintcputhumb2.create(R_INTREGISTER,R_SUBWHOLE,
               [RS_R0,RS_R1,RS_R2,RS_R3,RS_R4,RS_R5,RS_R6,RS_R7,RS_R8,
                RS_R10,RS_R12,RS_R14],first_int_imreg,[]);
-        rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBNONE,
+        if FPUARM_HAS_FPA in fpu_capabilities[current_settings.fputype] then
+          rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBNONE,
             [RS_F0,RS_F1,RS_F2,RS_F3,RS_F4,RS_F5,RS_F6,RS_F7],first_fpu_imreg,[]);
 
         if (FPUARM_HAS_32REGS in fpu_capabilities[current_settings.fputype]) and
@@ -4349,10 +4351,7 @@ unit cgcpu;
           rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBFD,
               [RS_D0,RS_D1,RS_D2,RS_D3,RS_D4,RS_D5,RS_D6,RS_D7,
                RS_D8,RS_D9,RS_D10,RS_D11,RS_D12,RS_D13,RS_D14,RS_D15
-              ],first_mm_imreg,[])
-        else
-          rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBNONE,
-              [RS_S0,RS_S1,RS_R2,RS_R3,RS_R4,RS_S31],first_mm_imreg,[]);
+              ],first_mm_imreg,[]);
       end;
 
 

+ 13 - 15
compiler/arm/cpuinfo.pas

@@ -40,7 +40,6 @@ Type
        cpu_armv3,
        cpu_armv4,
        cpu_armv4t,
-       cpu_armv5,
        cpu_armv5t,
        cpu_armv5te,
        cpu_armv5tej,
@@ -556,7 +555,6 @@ Const
      'ARMV3',
      'ARMV4',
      'ARMV4T',
-     'ARMV5',
      'ARMV5T',
      'ARMV5TE',
      'ARMV5TEJ',
@@ -1058,7 +1056,8 @@ Const
 
  type
    tcpuflags =
-      (CPUARM_HAS_ALL_MEM,    { CPU supports LDRSB/LDRSH/LDRH/STRH instructions           }
+      (CPUARM_HAS_THUMB,      { CPU supports THUMB                                        }
+       CPUARM_HAS_ALL_MEM,    { CPU supports LDRSB/LDRSH/LDRH/STRH instructions           }
        CPUARM_HAS_BX,         { CPU supports the BX instruction                           }
        CPUARM_HAS_BLX,        { CPU supports the BLX rX instruction                       }
        CPUARM_HAS_BLX_LABEL,  { CPU supports the BLX <label> instruction                  }
@@ -1092,22 +1091,21 @@ Const
      ( { cpu_none     } [],
        { cpu_armv3    } [],
        { cpu_armv4    } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_UMULL],
-       { cpu_armv4t   } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_UMULL],
-       { cpu_armv5    } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_CLZ,CPUARM_HAS_UMULL],
-       { cpu_armv5t   } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_UMULL],
-       { cpu_armv5te  } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_UMULL],
-       { cpu_armv5tej } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_UMULL],
+       { cpu_armv4t   } [CPUARM_HAS_THUMB,CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_UMULL],
+       { cpu_armv5t   } [CPUARM_HAS_THUMB,CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_UMULL],
+       { cpu_armv5te  } [CPUARM_HAS_THUMB,CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_UMULL],
+       { cpu_armv5tej } [CPUARM_HAS_THUMB,CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_UMULL],
        { cpu_armv6    } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_LDREX,CPUARM_HAS_UMULL],
        { cpu_armv6k   } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_LDREX,CPUARM_HAS_UMULL],
-       { cpu_armv6t2  } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_THUMB2,CPUARM_HAS_UMULL],
-       { cpu_armv6z   } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_LDREX,CPUARM_HAS_UMULL],
-       { cpu_armv6m   } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_REV],
+       { cpu_armv6t2  } [CPUARM_HAS_THUMB,CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_THUMB2,CPUARM_HAS_UMULL],
+       { cpu_armv6z   } [CPUARM_HAS_THUMB,CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_LDREX,CPUARM_HAS_UMULL],
+       { cpu_armv6m   } [CPUARM_HAS_THUMB,CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_REV],
        { the identifier armv7 is should not be used, it is considered being equal to armv7a }
        { cpu_armv7    } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_DMB,CPUARM_HAS_THUMB2,CPUARM_HAS_UMULL],
-       { cpu_armv7a   } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_DMB,CPUARM_HAS_THUMB2,CPUARM_HAS_UMULL],
-       { cpu_armv7r   } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_THUMB_IDIV,CPUARM_HAS_DMB,CPUARM_HAS_THUMB2,CPUARM_HAS_UMULL],
-       { cpu_armv7m   } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_THUMB_IDIV,CPUARM_HAS_DMB,CPUARM_HAS_THUMB2,CPUARM_HAS_UMULL],
-       { cpu_armv7em  } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_THUMB_IDIV,CPUARM_HAS_DMB,CPUARM_HAS_THUMB2,CPUARM_HAS_UMULL]
+       { cpu_armv7a   } [CPUARM_HAS_THUMB,CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_DMB,CPUARM_HAS_THUMB2,CPUARM_HAS_UMULL],
+       { cpu_armv7r   } [CPUARM_HAS_THUMB,CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_THUMB_IDIV,CPUARM_HAS_DMB,CPUARM_HAS_THUMB2,CPUARM_HAS_UMULL],
+       { cpu_armv7m   } [CPUARM_HAS_THUMB,CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_THUMB_IDIV,CPUARM_HAS_DMB,CPUARM_HAS_THUMB2,CPUARM_HAS_UMULL],
+       { cpu_armv7em  } [CPUARM_HAS_THUMB,CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_THUMB_IDIV,CPUARM_HAS_DMB,CPUARM_HAS_THUMB2,CPUARM_HAS_UMULL]
      );
 
      fpu_capabilities : array[tfputype] of set of tfpuflags =

+ 3 - 1
compiler/msg/errore.msg

@@ -2582,7 +2582,7 @@ cg_w_interrupt_does_not_save_registers=06062_W_The target CPU does not support p
 #
 # Assembler reader
 #
-# 07144 is the last used one
+# 07145 is the last used one
 #
 asmr_d_start_reading=07000_DL_Starting $1 styled assembler parsing
 % This informs you that an assembler block is being parsed
@@ -2924,6 +2924,8 @@ asmr_w_segment_override_ignored_in_64bit_mode=07141_W_Segment base $1 will be ge
 asmr_e_mismatch_broadcasting_elements=07142_E_Mismatch broadcasting elements (expected: {$1} found: {$2})
 asmr_e_invalid_arrangement=07143_E_Invalid arrangement specifier "$1"
 asmr_e_a64_invalid_regset=07144_E_Registers in a register set must be consecutive.
+asmr_e_unknown_field=07145_E_Unknown field identifier
+% The internal assembler read cannot find the passed field identifier.
 #
 # Assembler/binary writers
 #

+ 3 - 2
compiler/msgidx.inc

@@ -858,6 +858,7 @@ const
   asmr_e_mismatch_broadcasting_elements=07142;
   asmr_e_invalid_arrangement=07143;
   asmr_e_a64_invalid_regset=07144;
+  asmr_e_unknown_field=07145;
   asmw_f_too_many_asm_files=08000;
   asmw_f_assembler_output_not_supported=08001;
   asmw_f_comp_not_supported=08002;
@@ -1137,9 +1138,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 87094;
+  MsgTxtSize = 87127;
 
   MsgIdxMax : array[1..20] of longint=(
-    28,107,361,131,99,63,145,36,223,68,
+    28,107,361,131,99,63,146,36,223,68,
     63,20,30,1,1,1,1,1,1,1
   );

File diff suppressed because it is too large
+ 241 - 242
compiler/msgtxt.inc


+ 10 - 0
compiler/ncal.pas

@@ -1392,6 +1392,16 @@ implementation
                         else
                           make_not_regable(left,[ra_addr_regable])
                       end;
+                    vs_const:
+                      if parasym.vardef.typ=formaldef then
+                        begin
+                          { compilerprocs never capture the address of their
+                            parameters }
+                          if not(po_compilerproc in aktcallnode.procdefinition.procoptions) then
+                            make_not_regable(left,[ra_addr_regable,ra_addr_taken])
+                          else
+                            make_not_regable(left,[ra_addr_regable])
+                        end;
                     else
                       set_varstate(left,vs_read,[vsf_must_be_valid]);
                   end;

+ 1 - 0
compiler/rautils.pas

@@ -1645,6 +1645,7 @@ Begin
      sym:=search_struct_member(tabstractrecorddef(st.defowner),base);
      if not assigned(sym) then
       begin
+        Message(asmr_e_unknown_field);
         GetRecordOffsetSize:=false;
         exit;
       end;

+ 43 - 1
packages/fv/examples/testuapp.pas

@@ -1,15 +1,57 @@
 program testuapp;
 
+{$codepage UTF8}
+
 uses
-  uapp;
+  Objects, UDrivers, UViews, UMenus, UApp;
+
+const
+  cmOrderNew    = 200;
+  cmOrderWin    = 201;
+  cmOrderSave   = 202;
+  cmOrderCancel = 203;
+  cmOrderNext   = 204;
+  cmOrderPrev   = 205;
+  cmClipShow    = 210;
+  cmAbout       = 220;
+  cmFindOrderWindow = 1002;
+  cmOptionsVideo = 1502;
+  cmOptionsSave  = 1503;
+  cmOptionsLoad  = 1504;
 
 type
+
+  { TMyUnicodeApp }
+
   TMyUnicodeApp = object(TApplication)
+    procedure InitStatusLine; virtual;
   end;
 
 var
   MyUnicodeApp: TMyUnicodeApp;
 
+{ TMyUnicodeApp }
+
+procedure TMyUnicodeApp.InitStatusLine;
+var
+  R: TRect;
+begin
+  GetExtent(R);
+  R.A.Y := R.B.Y - 1;
+  new(StatusLine, Init(R,
+      NewStatusDef(0, $EFFF,
+          NewStatusKey('~F1~ 打开', kbF1, cmHelp,
+          NewStatusKey('~F3~ Отваряне', kbF3, cmOpen,
+          NewStatusKey('~F4~ Νέος',  kbF4, cmNew,
+          NewStatusKey('~Alt+F3~ Zavřít', kbAltF3, cmClose,
+          NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
+          nil))))),
+      NewStatusDef($F000, $FFFF,
+          NewStatusKey('~F6~ Next', kbF6, cmOrderNext,
+          NewStatusKey('~Shift+F6~ Pref', kbShiftF6, cmOrderPrev,
+          nil)),nil))));
+end;
+
 begin
   MyUnicodeApp.Init;
   MyUnicodeApp.Run;

+ 55 - 38
packages/rtl-objpas/src/inc/dateutil.inc

@@ -2379,6 +2379,8 @@ begin
 end;
 
 function scandatetime(const pattern:string;const s:string;const fmt:TFormatSettings;startpos:integer=1) : tdatetime;
+const
+  EPS = 1E-15;
 
 var len ,ind  : integer;
     yy,mm,dd  : integer;
@@ -2558,44 +2560,59 @@ begin
                        end;
                      end;
                'A' : begin
-                            i:=findimatch(AMPMformatting,@ptrn[pind]);
-                            case i of
-                              0: begin
-                                   i:=findimatch(['AM','PM'],@s[ind]);
-                                   case i of
-                                     0: ;
-                                     1: timeval:=timeval+12*hrfactor;
-                                   else
-                                     arraymatcherror
-                                     end;
-                                   inc(pind,length(AMPMformatting[0]));
-                                   inc(ind,2);
-                                 end;
-                              1: begin
-                                    case upcase(s[ind]) of
-                                     'A' : ;
-                                     'P' : timeval:=timeval+12*hrfactor;
-                                   else
-                                     arraymatcherror
-                                     end;
-                                   inc(pind,length(AMPMformatting[1]));
-                                   inc(ind);
-                                 end;
-                               2: begin
-                                    i:=findimatch([fmt.timeamstring,fmt.timepmstring],@s[ind]);
-                                    case i of
-                                     0: inc(ind,length(fmt.timeamstring));
-                                     1: begin
-                                          timeval:=timeval+12*hrfactor;
-                                          inc(ind,length(fmt.timepmstring));
-                                        end;
-                                   else
-                                     arraymatcherror
-                                     end;
-                                   inc(pind,length(AMPMformatting[2]));
-                                 end;
-                            else  // no AM/PM match. Assume 'a' is simply a char
-                                matchchar(ptrn[pind]);
+                        i:=findimatch(AMPMformatting,@ptrn[pind]);
+                        case i of
+                            0: begin
+                                 if timeval >= 13*hrfactor - EPS then
+                                   raiseexception(SAMPMError);
+                                 i:=findimatch(['AM','PM'],@s[ind]);
+                                 case i of
+                                   0: if timeval >= 12*hrfactor then
+                                        timeval := timeval - 12*hrfactor;
+                                   1: if (timeval + EPS >= hrfactor) and (timeval + EPS <= 12*hrfactor) then
+                                        timeval:=timeval+12*hrfactor;
+                                 else
+                                   arraymatcherror
+                                   end;
+                                 inc(pind,length(AMPMformatting[0]));
+                                 inc(ind,2);
+                               end;
+                            1: begin
+                                 if timeval >= 13*hrfactor - EPS then
+                                   raiseexception(SAMPMError);
+                                  case upcase(s[ind]) of
+                                   'A' : if timeval >= 12*hrfactor then
+                                           timeval := timeval - 12*hrfactor;
+                                   'P' : if (timeval + EPS >= hrfactor) and (timeval + EPS <= 12*hrfactor) then
+                                           timeval := timeval + 12*hrfactor;
+                                 else
+                                   arraymatcherror
+                                   end;
+                                 inc(pind,length(AMPMformatting[1]));
+                                 inc(ind);
+                               end;
+                             2: begin
+                                  if timeval >= 13*hrfactor - EPS then
+                                    raiseexception(SAMPMError);
+                                  i:=findimatch([fmt.timeamstring,fmt.timepmstring],@s[ind]);
+                                  case i of
+                                   0: begin
+                                        if timeval >= 12*hrfactor then
+                                          timeval := timeval - 12*hrfactor;
+                                        inc(ind,length(fmt.timeamstring));
+                                      end;
+                                   1: begin
+                                        if (timeval + EPS >= hrfactor) and (timeval + EPS <= 12*hrfactor) then
+                                          timeval:=timeval + 12*hrfactor;
+                                        inc(ind,length(fmt.timepmstring));
+                                      end;
+                                 else
+                                   arraymatcherror
+                                  end;
+                                 inc(pind,length(AMPMformatting[2]));
+                               end;
+                           else  // no AM/PM match. Assume 'a' is simply a char
+                               matchchar(ptrn[pind]);
                              end;
                          end;
                '/' : matchchar(fmt.dateSeparator);

+ 4 - 1
rtl/linux/arm/sighnd.inc

@@ -23,7 +23,7 @@ end;
 {$ifndef CPUTHUMB}
 Procedure SignalToHandleErrorAddrFrame_ARM(Errno : longint;addr : CodePointer; frame : Pointer); nostackframe; assembler;
 asm
-{$if FPC_VERSION >= 30200}
+{$if FPC_FULLVERSION >= 30200}
 .code 32
 {$endif}
   // the address is of the faulting instruction, and sigreturn will
@@ -57,6 +57,9 @@ asm
   mov lr, r0
   pop {r0,r1,r2,pc}
 .text
+{$ifndef CPUTHUMB}
+.code 32
+{$endif CPUTHUMB}
 end;
 {$endif}
 

+ 1 - 0
rtl/objpas/sysconst.pp

@@ -145,6 +145,7 @@ const
   SHHMMError                    = 'mm in a sequence hh:mm is interpreted as minutes. No longer versions allowed! (Position : %d).' ;
   SFullpattern                  = 'Couldn''t match entire pattern string. Input too short at pattern position %d.';
   SPatternCharMismatch          = 'Pattern mismatch char "%s" at position %d.';
+  SAMPMError                    = 'Hour >= 13 not allowed in AM/PM mode.';
 
   SShortMonthNameJan = 'Jan';
   SShortMonthNameFeb = 'Feb';

+ 106 - 0
tests/test/units/dateutil/test_scandatetime_ampm.pas

@@ -0,0 +1,106 @@
+program test_scandatetime_ampm;
+{$mode objfpc}
+{$h+}
+uses
+  SysUtils, DateUtils, StrUtils;
+
+Var
+ ErrCount : Integer;
+
+function SameDateTime(dt1, dt2: TDateTime): Boolean;
+const
+  EPS = 1/(24*60*60*100*10);  // 0.1 ms
+begin
+  Result := abs(dt1 - dt2) < EPS;
+end;
+
+procedure Test(AExpected: TDateTime; AFormatStr, ADateTimeStr: String; NeedError : Boolean = False);
+var
+  dt: TDateTime;
+begin
+  Write(PadRight(ADateTimeStr, 36), ' --->   ');
+  Write(PadRight(FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', dt), 25));
+  try
+    dt := ScanDateTime(AFormatStr, ADateTimeStr);
+    if dt = AExpected then WriteLn('OK') else 
+     begin
+     Inc(ErrCount);
+     WriteLn('ERROR');
+     end;
+  except on E:Exception do
+    begin
+    if not NeedError then
+      inc(errcount);
+    WriteLn('ERROR: ', E.Message);
+    end;
+  end;
+end;
+
+begin
+  errCount:=0;
+  WriteLn('Using current format settings...');
+  Test(EncodeDateTime(2014, 4, 2, 0, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 12:00 am');
+  Test(EncodeDateTime(2014, 4, 2, 0, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 12:00 AM');
+  Test(EncodeDateTime(2014, 4, 2, 0, 1, 0,  0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 12:01 am');
+  Test(EncodeDateTime(2014, 4, 2, 1, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 01:00 am');
+  Test(EncodeDateTime(2014, 4, 2,11, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 11:00 am');
+  Test(EncodeDateTime(2014, 4, 2,11,59, 0,  0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 11:59 am');
+  Test(EncodeDateTime(2014, 4, 2,11,59,59,999), 'mmmm dd??, yyyy, hh:nn:ss.zzz am/pm', 'April 2nd, 2014, 11:59:59.999 am');
+  Test(EncodeDateTime(2014, 4, 2,12, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 12:00 pm');
+  Test(EncodeDateTime(2014, 4, 2,12, 0, 0,  1), 'mmmm dd??, yyyy, hh:nn:ss.zzz am/pm', 'April 2nd, 2014, 12:00:00.001 pm');
+  Test(EncodeDateTime(2014, 4, 2,13, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 01:00 pm');
+  Test(EncodeDateTime(2014, 4, 2,13, 1, 0,  0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 01:01 pm');
+  Test(EncodeDateTime(2014, 4, 2,23, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 11:00 pm');
+  Test(EncodeDateTime(2014, 4, 2,23,59,59,999), 'mmmm dd??, yyyy, hh:nn:ss.zzz am/pm', 'April 2nd, 2014, 11:59:59.999 pm');
+
+  WriteLn;
+
+  Test(EncodeDateTime(2014, 4, 2, 0, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 12:00 a');
+  Test(EncodeDateTime(2014, 4, 2, 0, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 12:00 A');
+  Test(EncodeDateTime(2014, 4, 2, 0, 1, 0,  0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 12:01 a');
+  Test(EncodeDateTime(2014, 4, 2, 1, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 01:00 a');
+  Test(EncodeDateTime(2014, 4, 2,11, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 11:00 a');
+  Test(EncodeDateTime(2014, 4, 2,11,59, 0,  0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 11:59 a');
+  Test(EncodeDateTime(2014, 4, 2,11,59,59,999), 'mmmm dd??, yyyy, hh:nn:ss.zzz a/p', 'April 2nd, 2014, 11:59:59.999 a');
+  Test(EncodeDateTime(2014, 4, 2,12, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 12:00 p');
+  Test(EncodeDateTime(2014, 4, 2,12, 0, 0,  1), 'mmmm dd??, yyyy, hh:nn:ss.zzz a/p', 'April 2nd, 2014, 12:00:00.001 p');
+  Test(EncodeDateTime(2014, 4, 2,13, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 01:00 p');
+  Test(EncodeDateTime(2014, 4, 2,13, 1, 0,  0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 01:01 p');
+  Test(EncodeDateTime(2014, 4, 2,23, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 11:00 p');
+  Test(EncodeDateTime(2014, 4, 2,23,59,59,999), 'mmmm dd??, yyyy, hh:nn:ss.zzz a/p', 'April 2nd, 2014, 11:59:59.999 p');
+
+  WriteLn;
+
+  FormatSettings.TimeAMString := 'vorm';
+  FormatSettings.TimePMString := 'nachm';
+  WriteLn('Using modified format settings with ampm=', FormatSettings.TimeAMString, '/', FormatSettings.TimePMString);
+  Test(EncodeDateTime(2014, 4, 2, 0, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 12:00 vorm');
+  Test(EncodeDateTime(2014, 4, 2, 0, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 12:00 VORM');
+  Test(EncodeDateTime(2014, 4, 2, 0, 1, 0,  0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 12:01 vorm');
+  Test(EncodeDateTime(2014, 4, 2, 1, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 01:00 vorm');
+  Test(EncodeDateTime(2014, 4, 2,11, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 11:00 vorm');
+  Test(EncodeDateTime(2014, 4, 2,11,59, 0,  0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 11:59 vorm');
+  Test(EncodeDateTime(2014, 4, 2,11,59,59,999), 'mmmm dd??, yyyy, hh:nn:ss.zzz ampm', 'April 2nd, 2014, 11:59:59.999 vorm');
+  Test(EncodeDateTime(2014, 4, 2,12, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 12:00 nachm');
+  Test(EncodeDateTime(2014, 4, 2,12, 0, 0,  1), 'mmmm dd??, yyyy, hh:nn:ss.zzz ampm', 'April 2nd, 2014, 12:00:00.001 nachm');
+  Test(EncodeDateTime(2014, 4, 2,13, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 01:00 nachm');
+  Test(EncodeDateTime(2014, 4, 2,13, 1, 0,  0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 01:01 nachm');
+  Test(EncodeDateTime(2014, 4, 2,23, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 11:00 nachm');
+  Test(EncodeDateTime(2014, 4, 2,23,59,59,999), 'mmmm dd??, yyyy, hh:nn:ss.zzz ampm', 'April 2nd, 2014, 11:59:59.999 nachm');
+  Test(EncodeDateTime(2014, 4, 3,12, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 3rd, 2014, 12:00 nachm');
+  WriteLn('The next test should raise an exception.');
+
+  try
+    Test(EncodeDateTime(2014, 4, 2,13, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 13:00 pm',True);
+   
+  except on E:Exception do
+    begin
+    WriteLn('OK, exception received: ', E.Message);
+    end;
+  end;
+
+  WriteLn;
+  WriteLn('Test complete. Press RETURN to exit.');
+  Halt(Ord(errcount>0));
+//  ReadLn;
+end.

Some files were not shown because too many files changed in this diff