Jelajahi Sumber

+ -CTinitlocals switch for the JVM that initialises all local variables
that may trigger JVM bytecode verification errors if they are used
before they are initialised (this includes passing them as a "var"
parameter) + test
* sorted -CT parameters alphabetically and alligned them

git-svn-id: trunk@25387 -

Jonas Maebe 12 tahun lalu
induk
melakukan
a14ceba791

+ 1 - 0
.gitattributes

@@ -10634,6 +10634,7 @@ tests/test/jvm/testansi.pp svneol=native#text/plain
 tests/test/jvm/testintf.pp svneol=native#text/plain
 tests/test/jvm/testshort.pp svneol=native#text/plain
 tests/test/jvm/tformalpara.pp svneol=native#text/plain
+tests/test/jvm/tinitvar.pp svneol=native#text/plain
 tests/test/jvm/tint.pp svneol=native#text/plain
 tests/test/jvm/tintstr.pp svneol=native#text/plain
 tests/test/jvm/tjavalowercaseproc.java svneol=native#text/plain

+ 6 - 2
compiler/globtype.pas

@@ -236,7 +236,10 @@ interface
          { lowercase the first character of routine names, used to generate
            names that are compliant with Java coding standards from code
            written according to Delphi coding standards }
-         ts_lowercase_proc_start
+         ts_lowercase_proc_start,
+         { initialise local variables on the JVM target so you won't get
+           accidental uses of uninitialised values }
+         ts_init_locals
        );
        ttargetswitches = set of ttargetswitch;
 
@@ -318,7 +321,8 @@ interface
          (name: 'AUTOGETTERPREFIX';    hasvalue: true ; isglobal: false),
          (name: 'AUTOSETTERPREFIX';    hasvalue: true ; isglobal: false),
          (name: 'THUMBINTERWORKING';   hasvalue: false; isglobal: true ),
-         (name: 'LOWERCASEPROCSTART';  hasvalue: false; isglobal: true )
+         (name: 'LOWERCASEPROCSTART';  hasvalue: false; isglobal: true ),
+         (name: 'INITLOCALS';          hasvalue: false; isglobal: true )
        );
 
        { switches being applied to all CPUs at the given level }

+ 76 - 4
compiler/jvm/njvmutil.pas

@@ -26,9 +26,9 @@ unit njvmutil;
 interface
 
   uses
-    node,
+    node,nbas,
     ngenutil,
-    symtype,symconst,symsym;
+    symtype,symconst,symsym,symdef;
 
 
   type
@@ -38,6 +38,11 @@ interface
       class function force_init: boolean; override;
       class procedure insertbssdata(sym: tstaticvarsym); override;
       class function create_main_procdef(const name: string; potype: tproctypeoption; ps: tprocsym): tdef; override;
+
+      class function check_insert_trashing(pd: tprocdef): boolean; override;
+      class function  trashable_sym(p: tsym): boolean; override;
+      class procedure maybe_trash_variable(var stat: tstatementnode; p: tabstractnormalvarsym; trashn: tnode); override;
+
       class procedure InsertInitFinalTable; override;
       class procedure InsertThreadvarTablesTable; override;
       class procedure InsertThreadvars; override;
@@ -56,8 +61,8 @@ implementation
     uses
       verbose,cutils,globtype,globals,constexp,fmodule,
       aasmdata,aasmtai,cpubase,aasmcpu,
-      symdef,symbase,symtable,defutil,jvmdef,
-      nbas,ncnv,ncon,ninl,ncal,nld,nmem,
+      symbase,symtable,defutil,jvmdef,
+      ncnv,ncon,ninl,ncal,nld,nmem,
       ppu,
       pass_1;
 
@@ -301,6 +306,73 @@ implementation
     end;
 
 
+  class function tjvmnodeutils.check_insert_trashing(pd: tprocdef): boolean;
+    begin
+      { initialise locals with 0 }
+      if ts_init_locals in current_settings.targetswitches then
+        localvartrashing:=high(trashintvalues);
+      result:=inherited;
+    end;
+
+
+  class function tjvmnodeutils.trashable_sym(p: tsym): boolean;
+    begin
+      result:=
+        inherited and
+        not jvmimplicitpointertype(tabstractnormalvarsym(p).vardef);
+    end;
+
+
+  class procedure tjvmnodeutils.maybe_trash_variable(var stat: tstatementnode; p: tabstractnormalvarsym; trashn: tnode);
+    var
+      enumdef: tenumdef;
+      trashintval: int64;
+      trashenumval: longint;
+      trashable: boolean;
+    begin
+      trashable:=trashable_sym(p);
+      trashintval:=trashintvalues[localvartrashing];
+      { widechar is a separate type in the JVM, can't cast left hand to integer
+        like in common code }
+      if trashable and
+         is_widechar(tabstractvarsym(p).vardef) then
+        trash_small(stat,trashn,
+          cordconstnode.create(word(trashintval),tabstractvarsym(p).vardef,false))
+      { enums are class instances in the JVM -> create a valid instance }
+      else if trashable and
+         is_enum(tabstractvarsym(p).vardef) then
+        begin
+          enumdef:=tenumdef(tabstractvarsym(p).vardef);
+          trashenumval:=longint(trashintval);
+          if not assigned(enumdef.int2enumsym(trashenumval)) then
+            trashintval:=longint(enumdef.min);
+          trash_small(stat,trashn,
+            cordconstnode.create(trashintval,enumdef,false))
+        end
+      { can't init pointers with arbitrary values; procvardef and objectdef are
+        always pointer-sized here because tjvmnodeutils.trashablesym returns
+        false for jvm implicit pointer types }
+      else if trashable and
+         (tabstractvarsym(p).vardef.typ in [pointerdef,classrefdef,objectdef,procvardef]) then
+        trash_small(stat,trashn,cnilnode.create)
+      else if trashable and
+         is_real(tabstractvarsym(p).vardef) then
+        trash_small(stat,trashn,crealconstnode.create(trashintval,tabstractvarsym(p).vardef))
+      { don't use inherited routines because it typecasts left to the target
+        type, and that doesn't always work in the JVM }
+      else if trashable and
+         (is_integer(tabstractvarsym(p).vardef) or
+          is_cbool(tabstractvarsym(p).vardef) or
+          is_anychar(tabstractvarsym(p).vardef) or
+          is_currency(tabstractvarsym(p).vardef)) then
+        trash_small(stat,trashn,cordconstnode.create(trashintval,tabstractvarsym(p).vardef,false))
+      else if trashable and
+         is_pasbool(tabstractvarsym(p).vardef) then
+        trash_small(stat,trashn,cordconstnode.create(trashintval and 1,tabstractvarsym(p).vardef,false))
+      else
+        inherited;
+    end;
+
   class procedure tjvmnodeutils.InsertInitFinalTable;
     var
       hp : tused_unit;

+ 5 - 4
compiler/msg/errore.msg

@@ -3430,12 +3430,13 @@ J*2CT<x>_Target-specific code generation options
 A*2CT<x>_Target-specific code generation options
 p*3CTsmalltoc_ Generate smaller TOCs at the expense of execution speed (AIX)
 P*3CTsmalltoc_ Generate smaller TOCs at the expense of execution speed (AIX)
+J*3CTautogetterprefix=X_  Automatically create getters for properties with prefix X (empty string disables)
+J*3CTautosetterprefix=X_  Automatically create setters for properties with prefix X (empty string disables)
 J*3CTcompactintarrayinit_ Generate smaller (but potentially slower) code for initializing integer array constants
-J*3CTenumfieldinit_ Initialize enumeration fields in constructors to enumtype(0), after calling inherited constructors
-J*3CTautogetterprefix=X_ Automatically create getters for properties with prefix X (empty string disables)
-J*3CTautosetterprefix=X_ Automatically create setters for properties with prefix X (empty string disables)
+J*3CTenumfieldinit_       Initialize enumeration fields in constructors to enumtype(0), after calling inherited constructors
+J*3CTinitlocals_          Initialize local variables that trigger a JVM bytecode verification error if used uninitialized (slows down code)
+J*3CTlowercaseprocstart_  Lowercase the first character of procedure/function/method names
 A*3CTthumbinterworking_ Generate Thumb interworking-safe code if possible
-J*3CTlowercaseprocstart_ Lowercase the first character of procedure/function/method names
 J*2Cv_Var/out parameter copy-out checking
 **2CX_Create also smartlinked library
 **1d<x>_Defines the symbol <x>

+ 1 - 1
compiler/msgidx.inc

@@ -977,7 +977,7 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 69318;
+  MsgTxtSize = 69467;
 
   MsgIdxMax : array[1..20] of longint=(
     26,95,335,121,88,56,126,27,202,64,

+ 127 - 124
compiler/msgtxt.inc

@@ -1,7 +1,7 @@
 {$ifdef Delphi}
-const msgtxt : array[0..000288] of string[240]=(
+const msgtxt : array[0..000289] of string[240]=(
 {$else Delphi}
-const msgtxt : array[0..000288,1..240] of char=(
+const msgtxt : array[0..000289,1..240] of char=(
 {$endif Delphi}
   '01000_T_Compiler: $1'#000+
   '01001_D_Compiler OS: $1'#000+
@@ -1303,292 +1303,295 @@ const msgtxt : array[0..000288,1..240] of char=(
   'ed (AIX)'#010+
   'P*3CTsmalltoc_ Generate smaller TOCs at the expense of execution speed'+
   ' (AIX)'#010+
+  'J*3CTautogetterprefix=X_  Automatically create getters for properties '+
+  'with prefix X (empty string disables)'#010+
+  'J*3C','Tautosetterprefix=X_  Automatically create setters for propertie'+
+  's with prefix X (empty string disables)'#010+
   'J*3CTcompactintarrayinit_ Generate smaller (but potentially slower) co'+
-  'de for initializing integer array constant','s'#010+
-  'J*3CTenumfieldinit_ Initialize enumeration fields in constructors to e'+
-  'numtype(0), after calling inherited constructors'#010+
-  'J*3CTautogetterprefix=X_ Automatically create getters for properties w'+
-  'ith prefix X (empty string disables)'#010+
-  'J*3CTautoset','terprefix=X_ Automatically create setters for properties'+
-  ' with prefix X (empty string disables)'#010+
+  'de for initializing integer array constants'#010+
+  'J*3CTenumfieldinit_   ','    Initialize enumeration fields in construct'+
+  'ors to enumtype(0), after calling inherited constructors'#010+
+  'J*3CTinitlocals_          Initialize local variables that trigger a JV'+
+  'M bytecode verification error if used uninitialized (slows down cod','e'+
+  ')'#010+
+  'J*3CTlowercaseprocstart_  Lowercase the first character of procedure/f'+
+  'unction/method names'#010+
   'A*3CTthumbinterworking_ Generate Thumb interworking-safe code if possi'+
   'ble'#010+
-  'J*3CTlowercaseprocstart_ Lowercase the first character of procedure/fu'+
-  'n','ction/method names'#010+
   'J*2Cv_Var/out parameter copy-out checking'#010+
-  '**2CX_Create also smartlinked library'#010+
+  '**2CX_Create also smartlinked ','library'#010+
   '**1d<x>_Defines the symbol <x>'#010+
   '**1D_Generate a DEF file'#010+
   '**2Dd<x>_Set description to <x>'#010+
   '**2Dv<x>_Set DLL version to <x>'#010+
-  '*O2Dw_PM application'#010,
+  '*O2Dw_PM application'#010+
   '**1e<x>_Set path to executable'#010+
   '**1E_Same as -Cn'#010+
   '**1fPIC_Same as -Cg'#010+
-  '**1F<x>_Set file names and paths:'#010+
+  '**1F<x>_Set file names ','and paths:'#010+
   '**2Fa<x>[,y]_(for a program) load units <x> and [y] before uses is par'+
   'sed'#010+
   '**2Fc<x>_Set input codepage to <x>'#010+
-  '**2FC<x>_Set RC compiler bina','ry name to <x>'#010+
+  '**2FC<x>_Set RC compiler binary name to <x>'#010+
   '**2Fd_Disable the compiler'#039's internal directory cache'#010+
-  '**2FD<x>_Set the directory where to search for compiler utilities'#010+
+  '**2FD<x>_Set the direc','tory where to search for compiler utilities'#010+
   '**2Fe<x>_Redirect error output to <x>'#010+
   '**2Ff<x>_Add <x> to framework path (Darwin only)'#010+
-  '**2FE<x>_Set exe/u','nit output path to <x>'#010+
+  '**2FE<x>_Set exe/unit output path to <x>'#010+
   '**2Fi<x>_Add <x> to include path'#010+
   '**2Fl<x>_Add <x> to library path'#010+
-  '**2FL<x>_Use <x> as dynamic linker'#010+
+  '**','2FL<x>_Use <x> as dynamic linker'#010+
   '**2Fm<x>_Load unicode conversion table from <x>.txt in the compiler di'+
   'r'#010+
   '**2Fo<x>_Add <x> to object path'#010+
-  '**2Fr<x>_Loa','d error message file <x>'#010+
+  '**2Fr<x>_Load error message file <x>'#010+
   '**2FR<x>_Set resource (.res) linker to <x>'#010+
-  '**2Fu<x>_Add <x> to unit path'#010+
+  '**2Fu<x>_Add <x> to uni','t path'#010+
   '**2FU<x>_Set unit output path to <x>, overrides -FE'#010+
   '**2FW<x>_Store generated whole-program optimization feedback in <x>'#010+
-  '**2Fw<x>_Load previous','ly stored whole-program optimization feedback '+
-  'from <x>'#010+
-  '*g1g_Generate debug information (default format for target)'#010+
+  '**2Fw<x>_Load previously stored whole-program optimization feedback fr'+
+  'om <x>'#010+
+  '*g1g_Generate debug information (def','ault format for target)'#010+
   '*g2gc_Generate checks for pointers'#010+
   '*g2gh_Use heaptrace unit (for memory leak/corruption debugging)'#010+
-  '*g2gl_Use line info unit (','show more info with backtraces)'#010+
+  '*g2gl_Use line info unit (show more info with backtraces)'#010+
   '*g2go<x>_Set debug information options'#010+
-  '*g3godwarfsets_ Enable DWARF '#039'set'#039' type debug information (bre'+
-  'aks gdb < 6.5)'#010+
+  '*g3godwarfsets_ Enab','le DWARF '#039'set'#039' type debug information (b'+
+  'reaks gdb < 6.5)'#010+
   '*g3gostabsabsincludes_ Store absolute/full include file paths in Stabs'+
   #010+
-  '*g3godwarfmethodclass','prefix_ Prefix method names in DWARF with class'+
-  ' name'#010+
-  '*g2gp_Preserve case in stabs symbol names'#010+
+  '*g3godwarfmethodclassprefix_ Prefix method names in DWARF with class n'+
+  'ame'#010+
+  '*g2gp_Preserve case in stabs symbol na','mes'#010+
   '*g2gs_Generate Stabs debug information'#010+
   '*g2gt_Trash local variables (to detect uninitialized uses)'#010+
-  '*g2gv_Generates programs traceable with Valgrin','d'#010+
+  '*g2gv_Generates programs traceable with Valgrind'#010+
   '*g2gw_Generate DWARFv2 debug information (same as -gw2)'#010+
-  '*g2gw2_Generate DWARFv2 debug information'#010+
+  '*g2gw2_Generate DWARFv2 debug inf','ormation'#010+
   '*g2gw3_Generate DWARFv3 debug information'#010+
   '*g2gw4_Generate DWARFv4 debug information (experimental)'#010+
   '**1i_Information'#010+
-  '**2iD_Return compiler da','te'#010+
+  '**2iD_Return compiler date'#010+
   '**2iV_Return short compiler version'#010+
   '**2iW_Return full compiler version'#010+
-  '**2iSO_Return compiler OS'#010+
+  '**2iSO_Return com','piler OS'#010+
   '**2iSP_Return compiler host processor'#010+
   '**2iTO_Return target OS'#010+
   '**2iTP_Return target processor'#010+
   '**1I<x>_Add <x> to include path'#010+
-  '**1k<x>_Pass <x','> to the linker'#010+
+  '**1k<x>_Pass <x> to the linker'#010+
   '**1l_Write logo'#010+
   '**1M<x>_Set language mode to <x>'#010+
-  '**2Mfpc_Free Pascal dialect (default)'#010+
+  '**2Mfpc_Free Pascal dialec','t (default)'#010+
   '**2Mobjfpc_FPC mode with Object Pascal support'#010+
   '**2Mdelphi_Delphi 7 compatibility mode'#010+
   '**2Mtp_TP/BP 7.0 compatibility mode'#010+
-  '**2Mmacpas_Maci','ntosh Pascal dialects compatibility mode'#010+
+  '**2Mmacpas_Macintosh Pascal dialects compatibility mode'#010+
   '**1n_Do not read the default config files'#010+
-  '**1o<x>_Change the name of the executable produced to <x>'#010+
+  '**1o<x>_','Change the name of the executable produced to <x>'#010+
   '**1O<x>_Optimizations:'#010+
   '**2O-_Disable optimizations'#010+
-  '**2O1_Level 1 optimizations (quick and debugger ','friendly)'#010+
+  '**2O1_Level 1 optimizations (quick and debugger friendly)'#010+
   '**2O2_Level 2 optimizations (-O1 + quick optimizations)'#010+
-  '**2O3_Level 3 optimizations (-O2 + slow optimizations)'#010+
+  '**2O3_Level 3 optimizatio','ns (-O2 + slow optimizations)'#010+
   '**2O4_Level 4 optimizations (-O3 + optimizations which might have unex'+
   'pected side effects)'#010+
   '**2Oa<x>=<y>_Set alignment'#010+
-  '*','*2Oo[NO]<x>_Enable or disable optimizations, see fpc -i for possibl'+
-  'e values'#010+
-  '**2Op<x>_Set target cpu for optimizing, see fpc -i for possible values'+
-  #010+
+  '**2Oo[NO]<x>_Enable or disable optimizations, see fpc -i for possible '+
+  'values'#010+
+  '**2Op<x>_Set ta','rget cpu for optimizing, see fpc -i for possible valu'+
+  'es'#010+
   '**2OW<x>_Generate whole-program optimization feedback for optimization'+
-  ' <x>, see fpc -i for po','ssible values'#010+
+  ' <x>, see fpc -i for possible values'#010+
   '**2Ow<x>_Perform whole-program optimization <x>, see fpc -i for possib'+
-  'le values'#010+
+  'le valu','es'#010+
   '**2Os_Optimize for size rather than speed'#010+
   '**1pg_Generate profile code for gprof (defines FPC_PROFILE)'#010+
-  'F*1P<x>_Target CPU / compiler related option','s:'#010+
+  'F*1P<x>_Target CPU / compiler related options:'#010+
   'F*2PB_Show default compiler binary'#010+
   'F*2PP_Show default target cpu'#010+
-  'F*2P<x>_Set target CPU (arm,i386,m68k,mips,mipsel,powerpc,powerpc64,sp'+
-  'arc,x86_64'#010+
+  'F*2P<x>_Set target CPU ','(arm,i386,m68k,mips,mipsel,powerpc,powerpc64,'+
+  'sparc,x86_64'#010+
   '**1R<x>_Assembler reading style:'#010+
   '**2Rdefault_Use default assembler for target'#010+
-  '3*2Ratt_Read ','AT&T style assembler'#010+
+  '3*2Ratt_Read AT&T style assembler'#010+
   '3*2Rintel_Read Intel style assembler'#010+
-  '6*2RMOT_Read motorola style assembler'#010+
+  '6*2RMOT_Read motorola style assem','bler'#010+
   '**1S<x>_Syntax options:'#010+
   '**2S2_Same as -Mobjfpc'#010+
   '**2Sc_Support operators like C (*=,+=,/= and -=)'#010+
   '**2Sa_Turn on assertions'#010+
-  '**2Sd_Same as -Mdelphi'#010,
+  '**2Sd_Same as -Mdelphi'#010+
   '**2Se<x>_Error options. <x> is a combination of the following:'#010+
-  '**3*_<n> : Compiler halts after the <n> errors (default is 1)'#010+
+  '**3*_<n> : Compiler halts af','ter the <n> errors (default is 1)'#010+
   '**3*_w : Compiler also halts after warnings'#010+
   '**3*_n : Compiler also halts after notes'#010+
-  '**3*_h : Compiler also halts a','fter hints'#010+
+  '**3*_h : Compiler also halts after hints'#010+
   '**2Sg_Enable LABEL and GOTO (default in -Mtp and -Mdelphi)'#010+
-  '**2Sh_Use reference counted strings (ansistring by default) instead of'+
-  ' shortstrings'#010+
+  '**2Sh_Use reference c','ounted strings (ansistring by default) instead '+
+  'of shortstrings'#010+
   '**2Si_Turn on inlining of procedures/functions declared as "inline"'#010+
-  '**2Sk_Load fpcylix',' unit'#010+
+  '**2Sk_Load fpcylix unit'#010+
   '**2SI<x>_Set interface style to <x>'#010+
   '**3SIcom_COM compatible interface (default)'#010+
-  '**3SIcorba_CORBA compatible interface'#010+
+  '**3SI','corba_CORBA compatible interface'#010+
   '**2Sm_Support macros like C (global)'#010+
   '**2So_Same as -Mtp'#010+
-  '**2Ss_Constructor name must be init (destructor must be done',')'#010+
+  '**2Ss_Constructor name must be init (destructor must be done)'#010+
   '**2Sx_Enable exception keywords (default in Delphi/ObjFPC modes)'#010+
-  '**2Sy_@<pointer> returns a typed pointer, same as $T+'#010+
+  '**2Sy_@<pointer> returns',' a typed pointer, same as $T+'#010+
   '**1s_Do not call assembler and linker'#010+
   '**2sh_Generate script to link on host'#010+
   '**2st_Generate script to link on target'#010+
-  '**2','sr_Skip register allocation phase (use with -alr)'#010+
+  '**2sr_Skip register allocation phase (use with -alr)'#010+
   '**1T<x>_Target operating system:'#010+
-  '3*2Tdarwin_Darwin/Mac OS X'#010+
+  '3*2Tdarw','in_Darwin/Mac OS X'#010+
   '3*2Temx_OS/2 via EMX (including EMX/RSX extender)'#010+
   '3*2Tfreebsd_FreeBSD'#010+
   '3*2Tgo32v2_Version 2 of DJ Delorie DOS extender'#010+
-  '3*2Tiphonesi','m_ iPhoneSimulator from iOS SDK 3.2+ (older versions: -T'+
-  'darwin)'#010+
+  '3*2Tiphonesim_ iPhoneSimulator from iOS SDK 3.2+ (older versions: -Tda'+
+  'rwin)'#010+
   '3*2Tlinux_Linux'#010+
-  '3*2Tnativent_Native NT API (experimental)'#010+
+  '3*2Tnativen','t_Native NT API (experimental)'#010+
   '3*2Tnetbsd_NetBSD'#010+
   '3*2Tnetware_Novell Netware Module (clib)'#010+
   '3*2Tnetwlibc_Novell Netware Module (libc)'#010+
-  '3*2Topenbsd_OpenB','SD'#010+
+  '3*2Topenbsd_OpenBSD'#010+
   '3*2Tos2_OS/2 / eComStation'#010+
   '3*2Tsunos_SunOS/Solaris'#010+
   '3*2Tsymbian_Symbian OS'#010+
-  '3*2Tsolaris_Solaris'#010+
+  '3*2Tsolaris_So','laris'#010+
   '3*2Twatcom_Watcom compatible DOS extender'#010+
   '3*2Twdosx_WDOSX DOS extender'#010+
   '3*2Twin32_Windows 32 Bit'#010+
   '3*2Twince_Windows CE'#010+
-  '4*2Tdarwin_Darwin/Mac OS X',#010+
+  '4*2Tdarwin_Darwin/Mac OS X'#010+
   '4*2Tlinux_Linux'#010+
   '4*2Twin64_Win64 (64 bit Windows systems)'#010+
   '6*2Tamiga_Commodore Amiga'#010+
-  '6*2Tatari_Atari ST/STe/TT'#010+
+  '6*2Tata','ri_Atari ST/STe/TT'#010+
   '6*2Tlinux_Linux'#010+
   '6*2Tpalmos_PalmOS'#010+
   'A*2Tdarwin_Darwin/iPhoneOS/iOS'#010+
   'A*2Tlinux_Linux'#010+
   'A*2Twince_Windows CE'#010+
   'P*2Tamiga_AmigaOS'#010+
-  'P*2Tdarwin','_Darwin/Mac OS X'#010+
+  'P*2Tdarwin_Darwin/Mac OS X'#010+
   'P*2Tlinux_Linux'#010+
   'P*2Tmacos_Mac OS (classic)'#010+
   'P*2Tmorphos_MorphOS'#010+
-  'S*2Tsolaris_Solaris'#010+
+  'S*2Tsolaris','_Solaris'#010+
   'S*2Tlinux_Linux'#010+
   '**1u<x>_Undefines the symbol <x>'#010+
   '**1U_Unit options:'#010+
   '**2Un_Do not check where the unit name matches the file name'#010+
-  '**2Ur_Gener','ate release unit files (never automatically recompiled)'#010+
+  '**2Ur_Generate release unit files (never automatically recompiled)'#010+
   '**2Us_Compile a system unit'#010+
-  '**1v<x>_Be verbose. <x> is a combination of the following letters:'#010+
+  '**1v<x>','_Be verbose. <x> is a combination of the following letters:'#010+
   '**2*_e : Show errors (default)       0 : Show nothing (except errors)'#010+
-  '**2*_w : Show warni','ngs               u : Show unit info'#010+
-  '**2*_n : Show notes                  t : Show tried/used files'#010+
+  '**2*_w : Show warnings               u : Show unit info'#010+
+  '**2*_n : Show notes                  t : Show tried/us','ed files'#010+
   '**2*_h : Show hints                  c : Show conditionals'#010+
   '**2*_i : Show general info           d : Show debug info'#010+
-  '**2*_l : Show linenumber','s            r : Rhide/GCC compatibility mod'+
-  'e'#010+
-  '**2*_s : Show time stamps            q : Show message numbers'#010+
+  '**2*_l : Show linenumbers            r : Rhide/GCC compatibility mode'#010+
+  '**2*_s : Show time stamps            q : Show',' message numbers'#010+
   '**2*_a : Show everything             x : Executable info (Win32 only)'#010+
-  '**2*_b : Write file names messages   p : Write tree.log with p','arse t'+
-  'ree'#010+
+  '**2*_b : Write file names messages   p : Write tree.log with parse tre'+
+  'e'#010+
   '**2*_    with full path              v : Write fpcdebug.txt with'#010+
-  '**2*_                                    lots of debugging info'#010+
+  '**2*_           ','                         lots of debugging info'#010+
   '**2*_m<x>,<y> : Don'#039't show messages numbered <x> and <y>'#010+
-  'F*1V<x>_Append '#039'-<x>'#039' to the used compiler b','inary name (e.g.'+
-  ' for version)'#010+
+  'F*1V<x>_Append '#039'-<x>'#039' to the used compiler binary name (e.g. f'+
+  'or version)'#010+
   '**1W<x>_Target-specific options (targets)'#010+
-  '3*2WA_Specify native type application (Windows)'#010+
+  '3*2WA_Specify nativ','e type application (Windows)'#010+
   '4*2WA_Specify native type application (Windows)'#010+
   'A*2WA_Specify native type application (Windows)'#010+
-  '3*2Wb_Create a bundle in','stead of a library (Darwin)'#010+
+  '3*2Wb_Create a bundle instead of a library (Darwin)'#010+
   'P*2Wb_Create a bundle instead of a library (Darwin)'#010+
-  'p*2Wb_Create a bundle instead of a library (Darwin)'#010+
+  'p*2Wb_Creat','e a bundle instead of a library (Darwin)'#010+
   'A*2Wb_Create a bundle instead of a library (Darwin)'#010+
   '4*2Wb_Create a bundle instead of a library (Darwin)'#010+
-  '3*2W','B_Create a relocatable image (Windows, Symbian)'#010+
-  '3*2WBxxxx_Set image base to xxxx (Windows, Symbian)'#010+
+  '3*2WB_Create a relocatable image (Windows, Symbian)'#010+
+  '3*2WBxxxx_Set image base to xxxx (Windows, ','Symbian)'#010+
   '4*2WB_Create a relocatable image (Windows)'#010+
   '4*2WBxxxx_Set image base to xxxx (Windows)'#010+
   'A*2WB_Create a relocatable image (Windows, Symbian)'#010+
-  'A*','2WBxxxx_Set image base to xxxx (Windows, Symbian)'#010+
-  '3*2WC_Specify console type application (EMX, OS/2, Windows)'#010+
+  'A*2WBxxxx_Set image base to xxxx (Windows, Symbian)'#010+
+  '3*2WC_Specify console type application (E','MX, OS/2, Windows)'#010+
   '4*2WC_Specify console type application (EMX, OS/2, Windows)'#010+
   'A*2WC_Specify console type application (Windows)'#010+
-  'P*2WC_Specify console',' type application (Classic Mac OS)'#010+
-  '3*2WD_Use DEFFILE to export functions of DLL or EXE (Windows)'#010+
+  'P*2WC_Specify console type application (Classic Mac OS)'#010+
+  '3*2WD_Use DEFFILE to export functions of DLL or EXE (Win','dows)'#010+
   '4*2WD_Use DEFFILE to export functions of DLL or EXE (Windows)'#010+
   'A*2WD_Use DEFFILE to export functions of DLL or EXE (Windows)'#010+
-  '3*2We_Use external ','resources (Darwin)'#010+
+  '3*2We_Use external resources (Darwin)'#010+
   '4*2We_Use external resources (Darwin)'#010+
-  'A*2We_Use external resources (Darwin)'#010+
+  'A*2We_Use external resources (Darw','in)'#010+
   'P*2We_Use external resources (Darwin)'#010+
   'p*2We_Use external resources (Darwin)'#010+
   '3*2WF_Specify full-screen type application (EMX, OS/2)'#010+
-  '3*2WG_Specify ','graphic type application (EMX, OS/2, Windows)'#010+
-  '4*2WG_Specify graphic type application (EMX, OS/2, Windows)'#010+
+  '3*2WG_Specify graphic type application (EMX, OS/2, Windows)'#010+
+  '4*2WG_Specify graphic type application (EMX, ','OS/2, Windows)'#010+
   'A*2WG_Specify graphic type application (Windows)'#010+
   'P*2WG_Specify graphic type application (Classic Mac OS)'#010+
-  '3*2Wi_Use internal resources ','(Darwin)'#010+
+  '3*2Wi_Use internal resources (Darwin)'#010+
   '4*2Wi_Use internal resources (Darwin)'#010+
   'A*2Wi_Use internal resources (Darwin)'#010+
-  'P*2Wi_Use internal resources (Darwin)'#010+
+  'P*2Wi_','Use internal resources (Darwin)'#010+
   'p*2Wi_Use internal resources (Darwin)'#010+
   '3*2WI_Turn on/off the usage of import sections (Windows)'#010+
-  '4*2WI_Turn on/off the ','usage of import sections (Windows)'#010+
-  'A*2WI_Turn on/off the usage of import sections (Windows)'#010+
+  '4*2WI_Turn on/off the usage of import sections (Windows)'#010+
+  'A*2WI_Turn on/off the usage of import sections (Windows)',#010+
   '8*2Wm<x>_Set memory model'#010+
   '8*3WmTiny_Tiny memory model'#010+
   '8*3WmSmall_Small memory model (default)'#010+
   '8*3WmMedium_Medium memory model'#010+
-  '3*2WM<x>_Minimum Mac O','S X deployment version: 10.4, 10.5.1, ... (Dar'+
-  'win)'#010+
-  '4*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
+  '3*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
   'n)'#010+
+  '4*2WM<x>_Minimum Mac OS X deployment ver','sion: 10.4, 10.5.1, ... (Dar'+
+  'win)'#010+
   'p*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
   'n)'#010+
-  'P*2WM<x>_Minimum Mac OS X deployment versio','n: 10.4, 10.5.1, ... (Dar'+
-  'win)'#010+
-  '3*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
+  'P*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
+  'n)'#010+
+  '3*2WN_Do not generate relocation code, needed for debugging (','Windows'+
+  ')'#010+
   '4*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
-  'A*2WN_Do not generate relocation code, needed for debugging (Windows)'#010,
+  'A*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
   'A*2Wpxxxx_Specify the controller type, see fpc -i for possible values'#010+
-  'V*2Wpxxxx_Specify the controller type, see fpc -i for possible values'#010+
+  'V*2Wpxxxx_Specify the',' controller type, see fpc -i for possible value'+
+  's'#010+
   '3*2WP<x>_Minimum iOS deployment version: 3.0, 5.0.1, ... (iphonesim)'#010+
-  'A*2WP<x>_Minimum iOS deployment',' version: 3.0, 5.0.1, ... (Darwin)'#010+
+  'A*2WP<x>_Minimum iOS deployment version: 3.0, 5.0.1, ... (Darwin)'#010+
   '3*2WR_Generate relocation code (Windows)'#010+
-  '4*2WR_Generate relocation code (Windows)'#010+
+  '4*2WR_Generate ','relocation code (Windows)'#010+
   'A*2WR_Generate relocation code (Windows)'#010+
   'P*2WT_Specify MPW tool type application (Classic Mac OS)'#010+
-  '**2WX_Enable executable s','tack (Linux)'#010+
+  '**2WX_Enable executable stack (Linux)'#010+
   '**1X_Executable options:'#010+
-  '**2Xc_Pass --shared/-dynamic to the linker (BeOS, Darwin, FreeBSD, Lin'+
-  'ux)'#010+
+  '**2Xc_Pass --shared/-dynamic to the linker (BeOS, Dar','win, FreeBSD, L'+
+  'inux)'#010+
   '**2Xd_Do not search default library path (sometimes required for cross'+
   '-compiling when not using -XR)'#010+
   '**2Xe_Use external linker'#010+
-  '*','*2Xg_Create debuginfo in a separate file and add a debuglink sectio'+
-  'n to executable'#010+
-  '**2XD_Try to link units dynamically      (defines FPC_LINK_DYNAMIC)'#010+
+  '**2Xg_Create debuginfo in a separate file and add a debuglink section '+
+  'to executable'#010+
+  '**2XD_Tr','y to link units dynamically      (defines FPC_LINK_DYNAMIC)'#010+
   '**2Xi_Use internal linker'#010+
   '**2Xm_Generate link map'#010+
-  '**2XM<x>_Set the name of the '#039'main'#039' pro','gram routine (default'+
-  ' is '#039'main'#039')'#010+
-  'F*2Xp<x>_First search for the compiler binary in the directory <x>'#010+
+  '**2XM<x>_Set the name of the '#039'main'#039' program routine (default i'+
+  's '#039'main'#039')'#010+
+  'F*2Xp<x>_First search for the compiler binary in the direc','tory <x>'#010+
   '**2XP<x>_Prepend the binutils names with the prefix <x>'#010+
   '**2Xr<x>_Set the linker'#039's rlink-path to <x> (needed for cross comp'+
-  'ile, see the ld ma','nual for more information) (BeOS, Linux)'#010+
-  '**2XR<x>_Prepend <x> to all linker search paths (BeOS, Darwin, FreeBSD'+
-  ', Linux, Mac OS, Solaris)'#010+
+  'ile, see the ld manual for more information) (BeOS, Linux)'#010+
+  '**2XR<x>_Prepend <x> to all linker search paths (B','eOS, Darwin, FreeB'+
+  'SD, Linux, Mac OS, Solaris)'#010+
   '**2Xs_Strip all symbols from executable'#010+
-  '**2XS_Try to link units statically (default, defines FPC_LINK_S','TATIC'+
-  ')'#010+
+  '**2XS_Try to link units statically (default, defines FPC_LINK_STATIC)'#010+
   '**2Xt_Link with static libraries (-static is passed to linker)'#010+
-  '**2XX_Try to smartlink units             (defines FPC_LINK_SMART)'#010+
+  '**2XX_Try to smartlin','k units             (defines FPC_LINK_SMART)'#010+
   '**1*_'#010+
   '**1?_Show this help'#010+
   '**1h_Shows this help without waiting'

+ 10 - 3
compiler/ngenutil.pas

@@ -55,7 +55,8 @@ interface
      strict protected
       { called from wrap_proc_body to insert the trashing for the wrapped
         routine's local variables and parameters }
-      class function  maybe_insert_trashing(pd: tprocdef; n: tnode): tnode; virtual;
+      class function  maybe_insert_trashing(pd: tprocdef; n: tnode): tnode;
+      class function  check_insert_trashing(pd: tprocdef): boolean; virtual;
       { callback called for every local variable and parameter by
         maybe_insert_trashing(), calls through to maybe_trash_variable() }
       class procedure maybe_trash_variable_callback(p: TObject; statn: pointer);
@@ -330,8 +331,7 @@ implementation
       stat: tstatementnode;
     begin
       result:=n;
-      if (localvartrashing<>-1)  and
-         not(po_assembler in pd.procoptions) then
+      if check_insert_trashing(pd) then
         begin
           result:=internalstatements(stat);
           pd.parast.SymList.ForEachCall(@maybe_trash_variable_callback,@stat);
@@ -340,6 +340,13 @@ implementation
         end;
     end;
 
+  class function tnodeutils.check_insert_trashing(pd: tprocdef): boolean;
+    begin
+      result:=
+        (localvartrashing<>-1) and
+        not(po_assembler in pd.procoptions);
+    end;
+
 
   class function tnodeutils.trashable_sym(p: tsym): boolean;
     begin

+ 4 - 0
tests/test/jvm/testall.bat

@@ -276,3 +276,7 @@ javac -encoding utf-8 -cp ..\..\..\rtl\units\jvm-java;. tjavalowercaseproc.java
 if %errorlevel% neq 0 exit /b %errorlevel%
 java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tjavalowercaseproc
 if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g -B  -CTinitlocals tinitvar
+if %errorlevel% neq 0 exit /b %errorlevel%
+javaa -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. org.freepascal.test.tinitvar.tinitvar
+if %errorlevel% neq 0 exit /b %errorlevel%

+ 2 - 1
tests/test/jvm/testall.sh

@@ -154,4 +154,5 @@ java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/$RTLDIR:. tjsetter
 $PPC -O2 -g -B -Sa tlowercaseproc
 javac -encoding utf-8 -cp ../../../rtl/units/$RTLDIR:. tjavalowercaseproc.java
 java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/$RTLDIR:. tjavalowercaseproc
-
+$PPC -O2 -g -B -Sa -CTinitlocals tinitvar
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/$RTLDIR:. org.freepascal.test.tinitvar.tinitvar

+ 60 - 0
tests/test/jvm/tinitvar.pp

@@ -0,0 +1,60 @@
+program tinitvar;
+
+{$namespace org.freepascal.test.tinitvar}
+
+type
+  tenum = (ta,tb,tc);
+
+procedure varpara(
+var by: byte;
+var si: shortint;
+var mi: smallint;
+var wo: word;
+var li: longint;
+var ca: cardinal;
+var i6: int64;
+var qw: qword;
+var e: tenum;
+var sg: single;
+var db: double;
+var c: ansichar;
+var wc: widechar);
+begin
+end;
+
+procedure test;
+var
+  by: byte;
+  si: shortint;
+  mi: smallint;
+  wo: word;
+  li: longint;
+  ca: cardinal;
+  i6: int64;
+  qw: qword;
+  e: tenum;
+  sg: single;
+  db: double;
+  c: ansichar;
+  wc: widechar;
+begin
+  varpara(
+  by,
+  si,
+  mi,
+  wo,
+  li,
+  ca,
+  i6,
+  qw,
+  e,
+  sg,
+  db,
+  c,
+  wc
+  );
+end;
+
+begin
+  test;
+end.