Bläddra i källkod

+ support of winapi directive

git-svn-id: trunk@29500 -
florian 10 år sedan
förälder
incheckning
94a51e26a0
4 ändrade filer med 43 tillägg och 2 borttagningar
  1. 1 0
      .gitattributes
  2. 18 2
      compiler/pdecsub.pas
  3. 2 0
      compiler/tokens.pas
  4. 22 0
      tests/webtbs/tw27300a.pp

+ 1 - 0
.gitattributes

@@ -14203,6 +14203,7 @@ tests/webtbs/tw2728.pp svneol=native#text/plain
 tests/webtbs/tw2729.pp svneol=native#text/plain
 tests/webtbs/tw27294.pp svneol=native#text/plain
 tests/webtbs/tw2730.pp svneol=native#text/plain
+tests/webtbs/tw27300a.pp svneol=native#text/pascal
 tests/webtbs/tw2731.pp svneol=native#text/plain
 tests/webtbs/tw2736.pp svneol=native#text/plain
 tests/webtbs/tw2737.pp svneol=native#text/plain

+ 18 - 2
compiler/pdecsub.pas

@@ -2105,6 +2105,13 @@ begin
     pd_external(pd);
 end;
 
+procedure pd_winapi(pd:tabstractprocdef);
+begin
+  if not(target_info.system in systems_wince) then
+    pd.proccalloption:=pocall_cdecl
+  else
+    pd.proccalloption:=pocall_stdcall;
+end;
 
 type
    pd_handler=procedure(pd:tabstractprocdef);
@@ -2120,7 +2127,7 @@ type
    end;
 const
   {Should contain the number of procedure directives we support.}
-  num_proc_directives=44;
+  num_proc_directives=45;
   proc_direcdata:array[1..num_proc_directives] of proc_dir_rec=
    (
     (
@@ -2513,6 +2520,15 @@ const
       { allowed for external cpp classes }
       mutexclpotype : [{potype_constructor,potype_destructor}potype_class_constructor,potype_class_destructor];
       mutexclpo     : [po_public,po_exports,po_interrupt,po_assembler,po_inline]
+    ),(
+      idtok:_WINAPI;
+      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
+      handler  : @pd_winapi;
+      pocall   : pocall_none;
+      pooption : [];
+      mutexclpocall : [pocall_stdcall,pocall_cdecl];
+      mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor];
+      mutexclpo     : [po_external]
     ),(
       idtok:_ENUMERATOR;
       pd_flags : [pd_interface,pd_object,pd_record];
@@ -2609,7 +2625,7 @@ const
               next variable !! }
             if ((pdflags * [pd_procvar,pd_object,pd_record,pd_objcclass,pd_objcprot])=[]) and
                not(idtoken=_PROPERTY) then
-              Message1(parser_w_unknown_proc_directive_ignored,name);
+              Message1(parser_w_unknown_proc_directive_ignored,pattern);
             exit;
          end;
 

+ 2 - 0
compiler/tokens.pas

@@ -187,6 +187,7 @@ type
     _STRICT,
     _STRING,
     _SYSTEM,
+    _WINAPI,
     _ASMNAME,
     _CPPDECL,
     _DEFAULT,
@@ -505,6 +506,7 @@ const
       (str:'STRICT'        ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'STRING'        ;special:false;keyword:alllanguagemodes-[m_iso];op:NOTOKEN),
       (str:'SYSTEM'        ;special:false;keyword:[m_none];op:NOTOKEN),
+      (str:'WINAPI'        ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'ASMNAME'       ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'CPPDECL'       ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'DEFAULT'       ;special:false;keyword:[m_none];op:NOTOKEN),

+ 22 - 0
tests/webtbs/tw27300a.pp

@@ -0,0 +1,22 @@
+{ %OS=win32,win64,wince}
+{ %norun }
+program Project1;
+
+uses
+  Classes;
+
+const
+  kernel32 = 'kernel32.dll';
+
+type
+  BOOL = Boolean;
+  HANDLE = THandle;
+
+function OpenThread(
+  {_In_} dwDesiredAccess: DWORD;
+  {_In_} bInheritHandle: BOOL;
+  {_In_} dwThreadId: DWORD
+): HANDLE; WINAPI; external kernel32;
+
+begin
+end.