Add support for Default() intrinsic. For now this is only (fully) supported

in code and not in constants. In the case of primitive types constant nodes
are used while complex types like arrays, records and objects use a local
variable which is initialized to zero once at the entry of the method (the
variable is reused if Default() is used for the same type multiple times in
the same method). For this a new compilerproc was added which uses FillChar
to initialize the given memory area to zero.
This fixes Mantis #9420.

+ psystem.pas: Added Default symbol to system unit
+ htypechk.pas: Added function "is_valid_for_default" which checks recursively
                whether the given type can be used with Default at all. 
                Forbidden types are files, helpers, ObjC and C++ types. This
                check is used for records, arrays and objects only if the mode
                is a non-Delphi one, as Delphi ignores these types on lower
                levels.
+ msg/errore.msg: Added error message for unsupported types for Default()
+ symconst.pas: Added a new enum value vo_is_default_var which is used for the
                local variables utilized by Default() so their initalization
                and finalization can be avoided.
+ pexpr.pas: Add handling of Default() intrinsic to "statement_syssym"
+ ninl.pas: Extended tinlinenode by a method which returns the correct node for
            a Default() and used that method in handle_typecheck.
* ncgutil.pas: Check for new flag "vo_is_default_var" when initializing and
               finalizing local variables.
* ppu.pas: increase PPU version
+ psub.pas: 
  * Added a new routine which zeros defaultvars of a symtable.
  * Use this routine inside "initializevars".
  * Also use this routine to initialize the staticsymtable of the unit/program.
* Adjusted ppudump, because of the new enum value.
+ Added implementation of fpc_zeromem to system unit.
+ Added tests for Default()

git-svn-id: trunk@20629 -

.gitattributes

@@ -10250,6 +10250,22 @@ tests/test/tcptypedconst2.pp svneol=native#text/plain
 tests/test/tcptypedconst3.pp svneol=native#text/plain
 tests/test/tcstring1.pp svneol=native#text/pascal
 tests/test/tcstring2.pp svneol=native#text/pascal
+tests/test/tdefault1.pp svneol=native#text/pascal
+tests/test/tdefault10.pp svneol=native#text/pascal
+tests/test/tdefault11.pp svneol=native#text/pascal
+tests/test/tdefault12.pp svneol=native#text/pascal
+tests/test/tdefault13.pp svneol=native#text/pascal
+tests/test/tdefault14.pp svneol=native#text/pascal
+tests/test/tdefault15.pp svneol=native#text/pascal
+tests/test/tdefault16.pp svneol=native#text/pascal
+tests/test/tdefault2.pp svneol=native#text/pascal
+tests/test/tdefault3.pp svneol=native#text/pascal
+tests/test/tdefault4.pp svneol=native#text/pascal
+tests/test/tdefault5.pp svneol=native#text/pascal
+tests/test/tdefault6.pp svneol=native#text/pascal
+tests/test/tdefault7.pp svneol=native#text/pascal
+tests/test/tdefault8.pp svneol=native#text/pascal
+tests/test/tdefault9.pp svneol=native#text/pascal
 tests/test/tdel1.pp svneol=native#text/plain
 tests/test/tdel2.pp svneol=native#text/plain
 tests/test/tdispinterface1a.pp svneol=native#text/pascal

compiler/compinnr.inc

@@ -83,6 +83,7 @@ const
    in_sar_x             = 73;
    in_bsf_x             = 74;
    in_bsr_x             = 75;
+   in_default_x         = 76;
 
 { Internal constant functions }
    in_const_sqr        = 100;

compiler/htypechk.pas

@@ -174,6 +174,10 @@ interface
 
     procedure check_ranges(const location: tfileposinfo; source: tnode; destdef: tdef);
 
+    { returns whether the def may be used in the Default() intrinsic; static
+      arrays, records and objects are checked recursively }
+    function is_valid_for_default(def:tdef):boolean;
+
 implementation
 
     uses
@@ -2958,5 +2962,52 @@ implementation
          end;
       end;
 
+    function is_valid_for_default(def:tdef):boolean;
+
+      function is_valid_record_or_object(def:tabstractrecorddef):boolean;
+        var
+          sym : tsym;
+          i : longint;
+        begin
+          for i:=0 to def.symtable.symlist.count-1 do
+            begin
+              sym:=tsym(def.symtable.symlist[i]);
+              if sym.typ<>fieldvarsym then
+                continue;
+              if not is_valid_for_default(tfieldvarsym(sym).vardef) then
+                begin
+                  result:=false;
+                  exit;
+                end;
+            end;
+          result:=true;
+        end;
+
+      begin
+        case def.typ of
+          recorddef:
+            result:=is_valid_record_or_object(tabstractrecorddef(def));
+          objectdef:
+            if is_implicit_pointer_object_type(def) then
+              result:=true
+            else
+              if is_object(def) then
+                result:=is_valid_record_or_object(tabstractrecorddef(def))
+              else
+                result:=false;
+          arraydef:
+            if not (ado_isdynamicarray in tarraydef(def).arrayoptions) then
+              result:=is_valid_for_default(tarraydef(def).elementdef)
+            else
+              result:=true;
+          formaldef,
+          abstractdef,
+          filedef:
+            result:=false;
+          else
+            result:=true;
+        end;
+      end;
+
 
 end.

compiler/msg/errore.msg

@@ -774,9 +774,9 @@ parser_e_function_already_declared_public_forward=03120_E_Function is already de
 % declaration in the \var{implementation} section.
 parser_e_not_external_and_export=03121_E_Can't use both EXPORT and EXTERNAL
 % These two procedure directives are mutually exclusive.
-parser_h_not_supported_for_inline=03123_H_"$1" not yet supported inside inline procedure/function
+parser_w_not_supported_for_inline=03123_W_"$1" not yet supported inside inline procedure/function
 % Inline procedures don't support this declaration.
-parser_h_inlining_disabled=03124_H_Inlining disabled
+parser_w_inlining_disabled=03124_W_Inlining disabled
 % Inlining of procedures is disabled.
 parser_i_writing_browser_log=03125_I_Writing Browser log $1
 % When information messages are on, the compiler warns you when it
@@ -1413,7 +1413,7 @@ parser_e_invalid_codepage=03314_E_Invalid codepage
 % \end{description}
 # Type Checking
 #
-# 04110 is the last used one
+# 04111 is the last used one
 #
 % \section{Type checking errors}
 % This section lists all errors that can occur when type checking is
@@ -1799,6 +1799,8 @@ type_w_unicode_data_loss=04108_W_Unicode constant cast with potential data loss
 type_e_range_check_error_bounds=04109_E_range check error while evaluating constants ($1 must be between $2 and $3)
 type_w_range_check_error_bounds=04110_W_range check error while evaluating constants ($1 must be between $2 and $3)
 % The constants are outside their allowed range.
+type_e_type_not_allowed_for_default=04111_E_This type is not supported for the Default() intrinsic
+% Some types like for example Text and File Of X are not supported by the Default intrinsic.
 % \end{description}
 #
 # Symtable
@@ -3096,7 +3098,7 @@ wpo_cant_create_feedback_file=12019_E_Cannot create specified whole program opti
 #
 option_logo=11023_[
 Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPCCPU
-Copyright (c) 1993-2012 by Florian Klaempfl and others
+Copyright (c) 1993-2011 by Florian Klaempfl and others
 ]
 
 #

compiler/msgidx.inc

@@ -508,6 +508,7 @@ const
   type_w_unicode_data_loss=04108;
   type_e_range_check_error_bounds=04109;
   type_w_range_check_error_bounds=04110;
+  type_e_type_not_allowed_for_default=04111;
   sym_e_id_not_found=05000;
   sym_f_internal_error_in_symtablestack=05001;
   sym_e_duplicate_id=05002;
@@ -923,9 +924,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 63006;
+  MsgTxtSize = 63069;
 
   MsgIdxMax : array[1..20] of longint=(
-    26,90,315,111,85,55,116,26,202,63,
+    26,90,315,112,85,55,116,26,202,63,
     52,20,1,1,1,1,1,1,1,1
   );

compiler/ncgutil.pas

@@ -1496,6 +1496,7 @@ implementation
            ) and
            not(vo_is_typed_const in tabstractvarsym(p).varoptions) and
            not(vo_is_external in tabstractvarsym(p).varoptions) and
+           not(vo_is_default_var in tabstractvarsym(p).varoptions) and
            (is_managed_type(tabstractvarsym(p).vardef) or
             ((m_iso in current_settings.modeswitches) and (tabstractvarsym(p).vardef.typ=filedef))
            ) then
@@ -1537,6 +1538,7 @@ implementation
            (tlocalvarsym(p).refs>0) and
            not(vo_is_external in tlocalvarsym(p).varoptions) and
            not(vo_is_funcret in tlocalvarsym(p).varoptions) and
+           not(vo_is_default_var in tlocalvarsym(p).varoptions) and
            is_managed_type(tlocalvarsym(p).vardef) then
           finalize_sym(TAsmList(arg),tsym(p));
       end;

compiler/ninl.pas

@@ -71,6 +71,7 @@ interface
           function handle_typed_read_write(filepara,params:Ttertiarynode;var newstatement:Tnode):boolean;
           function handle_read_write: tnode;
           function handle_val: tnode;
+          function handle_default: tnode;
        end;
        tinlinenodeclass = class of tinlinenode;
 
@@ -84,7 +85,7 @@ implementation
     uses
       verbose,globals,systems,constexp,
       globtype, cutils,
-      symconst,symdef,symsym,symtable,paramgr,defutil,
+      symconst,symdef,symsym,symtable,paramgr,defutil,symbase,
       pass_1,
       ncal,ncon,ncnv,nadd,nld,nbas,nflw,nmem,nmat,nutils,
       nobjc,objcdef,
@@ -1359,6 +1360,130 @@ implementation
         result := newblock;
       end;
 
+    function tinlinenode.handle_default: tnode;
+
+      function getdefaultvarsym(def:tdef):tnode;
+        var
+          hashedid : thashedidstring;
+          srsym : tsym;
+          srsymtable : tsymtable;
+          defaultname : tidstring;
+        begin
+          if not assigned(def) or
+              not (def.typ in [arraydef,recorddef,variantdef,objectdef,procvardef]) or
+              ((def.typ=objectdef) and not is_object(def)) then
+            internalerror(201202101);
+          defaultname:=make_mangledname('zero',def.owner,def.typesym.Name);
+          hashedid.id:=defaultname;
+          { the default sym is always part of the current procedure/function }
+          srsymtable:=current_procinfo.procdef.localst;
+          srsym:=tsym(srsymtable.findwithhash(hashedid));
+          if not assigned(srsym) then
+            begin
+              { no valid default variable found, so create it }
+              srsym:=tlocalvarsym.create(defaultname,vs_const,def,[]);
+              srsymtable.insert(srsym);
+              { mark the staticvarsym as typedconst }
+              include(tabstractvarsym(srsym).varoptions,vo_is_typed_const);
+              include(tabstractvarsym(srsym).varoptions,vo_is_default_var);
+              { The variable has a value assigned }
+              tabstractvarsym(srsym).varstate:=vs_initialised;
+              { the variable can't be placed in a register }
+              tabstractvarsym(srsym).varregable:=vr_none;
+            end;
+          result:=cloadnode.create(srsym,srsymtable);
+        end;
+
+      var
+        def : tdef;
+      begin
+        if not assigned(left) or (left.nodetype<>typen) then
+          internalerror(2012032101);
+        def:=ttypenode(left).typedef;
+        result:=nil;
+        case def.typ of
+          enumdef,
+          orddef:
+            { don't do a rangecheck as Default will also return 0
+              for the following types (Delphi compatible):
+              TRange1 = -10..-5;
+              TRange2 = 5..10;
+              TEnum = (a:=5;b:=10); }
+            result:=cordconstnode.create(0,def,false);
+          classrefdef,
+          pointerdef:
+            result:=cpointerconstnode.create(0,def);
+          procvardef:
+            if tprocvardef(def).size<>sizeof(pint) then
+              result:=getdefaultvarsym(def)
+            else
+              result:=cpointerconstnode.create(0,def);
+          stringdef:
+            result:=cstringconstnode.createstr('');
+          floatdef:
+            result:=crealconstnode.create(0,def);
+          objectdef:
+            begin
+              if is_implicit_pointer_object_type(def) then
+                result:=cpointerconstnode.create(0,def)
+              else
+                if is_object(def) then
+                  begin
+                    { Delphi does not recursively check whether
+                      an object contains unsupported types }
+                    if not (m_delphi in current_settings.modeswitches) and
+                        not is_valid_for_default(def) then
+                      Message(type_e_type_not_allowed_for_default);
+                    result:=getdefaultvarsym(def);
+                  end
+                else
+                  Message(type_e_type_not_allowed_for_default);
+            end;
+          variantdef,
+          recorddef:
+            begin
+              { Delphi does not recursively check whether a record
+                contains unsupported types }
+              if (def.typ=recorddef) and not (m_delphi in current_settings.modeswitches) and
+                  not is_valid_for_default(def) then
+                Message(type_e_type_not_allowed_for_default);
+              result:=getdefaultvarsym(def);
+            end;
+          setdef:
+            begin
+              result:=csetconstnode.create(nil,def);
+              New(tsetconstnode(result).value_set);
+              tsetconstnode(result).value_set^:=[];
+            end;
+          arraydef:
+            begin
+              { can other array types be parsed by single_type? }
+              if ado_isdynamicarray in tarraydef(def).arrayoptions then
+                result:=cpointerconstnode.create(0,def)
+              else
+                begin
+                  result:=getdefaultvarsym(def);
+                end;
+            end;
+          undefineddef:
+            begin
+              if sp_generic_dummy in def.typesym.symoptions then
+                begin
+                  { this matches the error messages that are printed
+                    in case of non-Delphi modes }
+                  Message(parser_e_no_generics_as_types);
+                  Message(type_e_type_id_expected);
+                end
+              else
+                result:=cpointerconstnode.create(0,def);
+            end;
+          else
+            Message(type_e_type_not_allowed_for_default);
+        end;
+        if not assigned(result) then
+          result:=cerrornode.create;
+      end;
+
 {$maxfpuregisters 0}
 
     function getpi : bestreal;
@@ -2756,6 +2881,10 @@ implementation
                 begin
                   result:=handle_objc_encode;
                 end;
+              in_default_x:
+                begin
+                  result:=handle_default;
+                end;
               else
                 internalerror(8);
             end;
@@ -3094,7 +3223,7 @@ implementation
             internalerror(200104047);
 
           in_slice_x:
-            internalerror(2005101502);
+            internalerror(2005101501);
 
           in_ord_x,
           in_chr_byte:

compiler/pexpr.pas

@@ -265,6 +265,7 @@ implementation
         p1,p2,paras  : tnode;
         err,
         prev_in_args : boolean;
+        def : tdef;
       begin
         prev_in_args:=in_args;
         case l of
@@ -833,6 +834,26 @@ implementation
               statement_syssym:=geninlinenode(l,false,nil);
             end;
 *)
+          in_default_x:
+            begin
+              consume(_LKLAMMER);
+              in_args:=true;
+              def:=nil;
+              single_type(def,[stoAllowSpecialization]);
+              statement_syssym:=cerrornode.create;
+              if def=generrordef then
+                Message(type_e_type_id_expected)
+              else
+                if def.typ=forwarddef then
+                  Message1(type_e_type_is_not_completly_defined,tforwarddef(def).tosymname^)
+                else
+                  begin
+                    statement_syssym.free;
+                    statement_syssym:=geninlinenode(in_default_x,false,ctypenode.create(def));
+                  end;
+              { consume the right bracket here for a nicer error position }
+              consume(_RKLAMMER);
+            end;
           else
             internalerror(15);
 

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 145;
+  CurrentPPUVersion = 146;
 
 { buffer sizes }
   maxentrysize = 1024;

compiler/psub.pas

@@ -123,6 +123,34 @@ implementation
                       PROCEDURE/FUNCTION BODY PARSING
 ****************************************************************************}
 
+    procedure initializedefaultvars(p:TObject;arg:pointer);
+      var
+        b : tblocknode;
+      begin
+        if tsym(p).typ<>localvarsym then
+         exit;
+        with tabstractnormalvarsym(p) do
+         begin
+           if vo_is_default_var in varoptions then
+             begin
+               b:=tblocknode(arg);
+               b.left:=cstatementnode.create(
+                         ccallnode.createintern('fpc_zeromem',
+                           ccallparanode.create(
+                             cordconstnode.create(vardef.size,ptruinttype,false),
+                             ccallparanode.create(
+                               caddrnode.create_internal(
+                                 cloadnode.create(tsym(p),tsym(p).owner)),
+                                 nil
+                               )
+                             )
+                           ),
+                         b.left);
+             end;
+         end;
+      end;
+
+
     procedure initializevars(p:TObject;arg:pointer);
       var
         b : tblocknode;
@@ -139,7 +167,9 @@ implementation
                             cloadnode.create(tsym(p),tsym(p).owner),
                             cloadnode.create(defaultconstsym,defaultconstsym.owner)),
                         b.left);
-            end;
+            end
+           else
+             initializedefaultvars(p,arg);
          end;
       end;
 
@@ -232,7 +262,17 @@ implementation
                    current_filepos:=current_procinfo.entrypos;
                    current_procinfo.procdef.localst.SymList.ForEachCall(@initializevars,block);
                    current_filepos:=oldfilepos;
-                 end;
+                 end
+               else
+                 if current_procinfo.procdef.localst.symtabletype=staticsymtable then
+                   begin
+                     { for program and unit initialization code we also need to
+                       initialize the local variables used of Default() }
+                     oldfilepos:=current_filepos;
+                     current_filepos:=current_procinfo.entrypos;
+                     current_procinfo.procdef.localst.SymList.ForEachCall(@initializedefaultvars,block);
+                     current_filepos:=oldfilepos;
+                   end;
             end;
       end;
 

compiler/psystem.pas

@@ -102,6 +102,7 @@ implementation
         systemunit.insert(tsyssym.create('Unaligned',in_unaligned_x));
         systemunit.insert(tsyssym.create('ObjCSelector',in_objc_selector_x)); { objc only }
         systemunit.insert(tsyssym.create('ObjCEncode',in_objc_encode_x)); { objc only }
+        systemunit.insert(tsyssym.create('Default',in_default_x));
       end;
 
 

compiler/symconst.pas

@@ -444,7 +444,10 @@ type
     vo_has_section,
     { variable contains a winlike WideString which should be finalized
       even in $J- state }
-    vo_force_finalize
+    vo_force_finalize,
+    { this is an internal variable that is used for Default() intrinsic in code
+      sections }
+    vo_is_default_var
   );
   tvaroptions=set of tvaroption;
 

compiler/utils/ppudump.pp

@@ -1576,7 +1576,8 @@ const
      (mask:vo_is_first_field;str:'IsFirstField'),
      (mask:vo_volatile;str:'Volatile'),
      (mask:vo_has_section;str:'HasSection'),
-     (mask:vo_force_finalize;str:'ForceFinalize')
+     (mask:vo_force_finalize;str:'ForceFinalize'),
+     (mask:vo_is_default_var;str:'DefaultIntrinsicVar')
   );
 var
   i : longint;

rtl/inc/compproc.inc

@@ -35,6 +35,9 @@ Function  fpc_getmem(size:ptruint):pointer;compilerproc;
 Procedure fpc_freemem(p:pointer);compilerproc;
 {$endif FPC_HAS_FEATURE_HEAP}
 
+{ used by Default() in code blocks }
+procedure fpc_zeromem(p:pointer;len:ptruint);compilerproc;
+
 procedure fpc_Shortstr_SetLength(var s:shortstring;len:SizeInt); compilerproc;
 procedure fpc_shortstr_to_shortstr(out res:shortstring; const sstr: shortstring); compilerproc;
 

rtl/inc/system.inc

@@ -280,6 +280,10 @@ begin
   CompareChar:=CompareByte(buf1,buf2,len);
 end;
 
+procedure fpc_zeromem(p:pointer;len:ptruint);
+begin
+  FillChar(p^,len,0);
+end;
 
 { Include generic pascal only routines which are not defined in the processor
   specific include file }

tests/test/tdefault1.pp

@@ -0,0 +1,191 @@
+program tdefault1;
+
+{$APPTYPE CONSOLE}
+{$mode objfpc}
+{$modeswitch nestedprocvars}
+
+uses
+  variants;
+
+type
+  PLongInt = ^LongInt;
+
+  TTestRecord = record
+    first: LongInt;
+    second: AnsiString;
+    third: TObject;
+  end;
+
+  TTestObject = object
+    first: LongInt;
+    second: AnsiString;
+    third: TObject;
+  end;
+
+  TTestEnum1 = (
+    te1_1,
+    te1_2,
+    te1_3
+  );
+
+  TTestEnum2 = (
+    te2_1 = 4,
+    te2_2 = 8,
+    te2_3 = 12
+  );
+
+  TTestProcedure = procedure;
+  TTestMethod = procedure of object;
+  TTestNested = procedure is nested;
+
+  TTestSet1 = set of TTestEnum1;
+
+  TRange1 = -5..5;
+  TRange2 = -10..-5;
+  TRange3 = 5..10;
+
+  TTestArrayDyn = array of LongInt;
+  TTestArrayStatic = array[0..5] of LongInt;
+  TTestArrayStatic2 = array[0..5] of TTestRecord;
+
+var
+  trec, irec: TTestRecord;
+  tobj: TTestObject;
+  tstatic: TTestArrayStatic;
+  tstatic2: TTestArrayStatic2;
+  i: LongInt;
+begin
+  (* ordinal types *)
+  if Default(ShortInt) <> 0 then
+    Halt(1);
+  if Default(SmallInt) <> 0 then
+    Halt(2);
+  if Default(LongInt) <> 0 then
+    Halt(3);
+  if Default(Int64) <> 0 then
+    Halt(4);
+  if Default(Byte) <> 0 then
+    Halt(5);
+  if Default(Word) <> 0 then
+    Halt(6);
+  if Default(LongWord) <> 0 then
+    Halt(7);
+{$ifdef fpc}
+  if Default(QWord) <> 0 then
+    Halt(8);
+{$endif}
+  (* boolean types *)
+  if Default(Boolean) then
+    Halt(9);
+{$ifdef fpc}
+  if Default(Boolean16) then
+    Halt(10);
+  if Default(Boolean32) then
+    Halt(11);
+  if Default(Boolean64) then
+    Halt(12);
+{$endif}
+  if Default(ByteBool) then
+    Halt(13);
+  if Default(WordBool) then
+    Halt(14);
+  if Default(LongBool) then
+    Halt(15);
+{$ifdef fpc}
+  if not Default(QWordBool) then
+    Halt(16);
+{$endif}
+  (* comma types *)
+  if Default(Single) <> 0.0 then
+    Halt(17);
+  if Default(Double) <> 0.0 then
+    Halt(18);
+  if Default(Extended) <> 0.0 then
+    Halt(19);
+  if Default(Currency) <> 0.0 then
+    Halt(20);
+  if Default(Real) <> 0.0 then
+    Halt(21);
+  (* string types *)
+  if Default(ShortString) <> '' then
+    Halt(22);
+  if Default(AnsiString) <> '' then
+    Halt(23);
+  if Default(WideString) <> '' then
+    Halt(24);
+  if Default(UnicodeString) <> '' then
+    Halt(25);
+  if Default(String) <> '' then
+    Halt(26);
+  (* char types *)
+  if Default(AnsiChar) <> #0 then
+    Halt(27);
+  if Default(WideChar) <> #0 then
+    Halt(28);
+{$ifdef fpc}
+  if Default(UnicodeChar) <> #0 then
+    Halt(29);
+{$endif}
+  (* pointer types *)
+  if Default(Pointer) <> Nil then
+    Halt(30);
+  if Default(PLongInt) <> Nil then
+    Halt(31);
+  (* structured types *)
+  if Default(TObject) <> Nil then
+    Halt(32);
+  trec := Default(TTestRecord);
+  if trec.first <> 0 then
+    Halt(33);
+  if trec.second <> '' then
+    Halt(34);
+  if trec.third <> Nil then
+    Halt(35);
+  tobj := Default(TTestObject);
+  if tobj.first <> 0 then
+    Halt(36);
+  if tobj.second <> '' then
+    Halt(37);
+  if tobj.third <> Nil then
+    Halt(38);
+  if Default(IInterface) <> Nil then
+    Halt(39);
+  (* enumerations *)
+  if Default(TTestEnum1) <> te1_1 then
+    Halt(40);
+  if Ord(Default(TTestEnum2)) <> 0 then
+    Halt(41);
+  (* sets *)
+  if Default(TTestSet1) <> [] then
+    Halt(42);
+  (* range types *)
+  if Default(TRange1) <> 0 then
+    Halt(43);
+  if Default(TRange2) <> 0 then
+    Halt(44);
+  if Default(TRange3) <> 0 then
+    Halt(45);
+  (* procedural types *)
+  if Assigned(Default(TTestProcedure)) then
+    Halt(46);
+  if Assigned(Default(TTestMethod)) then
+    Halt(47);
+  (* Variant *)
+  if not VarIsEmpty(Default(Variant)) then
+    Halt(48);
+  (* Arrays *)
+  if Assigned(Default(TTestArrayDyn)) then
+    Halt(49);
+  tstatic := Default(TTestArrayStatic);
+  for i in tstatic do
+    if i <> 0 then
+      Halt(50);
+  tstatic2 := Default(TTestArrayStatic2);
+  for irec in tstatic2 do
+    if (irec.first <> 0) or (irec.second <> '') or assigned(irec.third) then
+      Halt(51);
+  (* other FPC specific types *)
+  if Assigned(Default(TTestNested)) then
+    Halt(52);
+  Writeln('ok');
+end.

tests/test/tdefault10.pp

@@ -0,0 +1,18 @@
+{ %NORUN }
+
+{ Default also supports inline specializations }
+program tdefault10;
+
+{$mode delphi}
+
+type
+  TTest<T> = class
+    f: T;
+  end;
+
+var
+  t: TTest<LongInt>;
+begin
+  t := Default(TTest<LongInt>);
+end.
+

tests/test/tdefault11.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+{ unspecialized generics are not allowed for default - case 1 }
+program tdefault11;
+
+{$mode delphi}
+
+type
+  TTest<T> = class
+
+  end;
+
+var
+  t: TObject;
+begin
+  t := Default(TTest);
+end.

tests/test/tdefault12.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+{ unspecialized generics are not allowed for default - case 2 }
+program tdefault12;
+
+{$mode objfpc}
+
+type
+  generic TTest<T> = class
+
+  end;
+
+var
+  t: TObject;
+begin
+  t := Default(TTest);
+end.

tests/test/tdefault13.pp

@@ -0,0 +1,14 @@
+{ %FAIL }
+
+{ helper types can not be used with default }
+program tdefault13;
+
+{$mode objfpc}
+
+type
+  TTestHelper = class helper for TObject
+  end;
+
+begin
+  Default(TTestHelper);
+end.

tests/test/tdefault14.pp

@@ -0,0 +1,15 @@
+{ %FAIL }
+
+{ As C++ classes aren't fully implemented we disallow Default for them as well }
+program tdefault14;
+
+type
+  TTest = cppclass
+    f: LongInt;
+  end;
+
+var
+  t: TTest;
+begin
+  t := Default(TTest);
+end.

tests/test/tdefault15.pp

@@ -0,0 +1,18 @@
+{ %FAIL }
+{ %target=darwin }
+
+{ Objective C types are disallowed as well }
+program tdefault15;
+
+{$mode objfpc}
+{$modeswitch objectivec1}
+
+type
+  TTest = objcclass
+  end;
+
+var
+  t: TTest;
+begin
+  t := Default(TTest);
+end.

tests/test/tdefault16.pp

@@ -0,0 +1,18 @@
+{ %FAIL }
+{ %target=darwin }
+
+{ Objective C types are disallowed as well }
+program tdefault16;
+
+{$mode objfpc}
+{$modeswitch objectivec1}
+
+type
+  TTest = objcprotocol
+  end;
+
+var
+  t: TTest;
+begin
+  t := Default(TTest);
+end.

tests/test/tdefault2.pp

@@ -0,0 +1,10 @@
+{ %FAIL }
+
+{ Text files are not allowed for Default }
+program tdefault2;
+
+var
+  t: TextFile;
+begin
+  t := Default(TextFile);
+end.

tests/test/tdefault3.pp

@@ -0,0 +1,13 @@
+{ %FAIL }
+
+{ Typed files are not allowed for Default }
+program tdefault3;
+
+type
+  TFileLongInt = file of LongInt;
+
+var
+  t: TFileLongInt;
+begin
+  t := Default(TFileLongInt);
+end.

tests/test/tdefault4.pp

@@ -0,0 +1,13 @@
+{ %FAIL }
+
+{ untyped files are not allowed for Default }
+program tdefault4;
+
+type
+  TUntypedFile = file;
+
+var
+  t: TUntypedFile;
+begin
+  t := Default(TUntypedFile);
+end.

tests/test/tdefault5.pp

@@ -0,0 +1,24 @@
+{ %NORUN }
+
+{ In Delphi mode unsupported types like TextFile are ignored inside records
+  and objects }
+program tdefault5;
+
+{$mode delphi}
+
+type
+  TTestRecord = record
+    f: TextFile;
+  end;
+
+  TTestObject = object
+    f: TextFile;
+  end;
+
+var
+  trec: TTestRecord;
+  tobj: TTestObject;
+begin
+  trec := Default(TTestRecord);
+  tobj := Default(TTestObject);
+end.

tests/test/tdefault6.pp

@@ -0,0 +1,16 @@
+{ %FAIL }
+
+{ In non-Delphi modes unsupported types like TextFile are not allowed inside
+  records and objects - case 1 }
+program tdefault6;
+
+type
+  TTestRecord = record
+    f: TextFile;
+  end;
+
+var
+  trec: TTestRecord;
+begin
+  trec := Default(TTestRecord);
+end.

tests/test/tdefault7.pp

@@ -0,0 +1,16 @@
+{ %FAIL }
+
+{ In non-Delphi modes unsupported types like TextFile are not allowed inside
+  records and objects - case 2 }
+program tdefault7;
+
+type
+  TTestObject = object
+    f: TextFile;
+  end;
+
+var
+  tobj: TTestObject;
+begin
+  tobj := Default(TTestObject);
+end.

tests/test/tdefault8.pp

@@ -0,0 +1,30 @@
+{ %NORUN }
+
+{ nested types can be used as well }
+program tdefault8;
+
+{$mode objfpc}
+
+type
+  TTest = class
+  public type
+    TRecord = record
+      f: LongInt;
+    end;
+
+    TRange = -5..5;
+
+    TSomeClass = class
+
+    end;
+  end;
+
+var
+  trec: TTest.TRecord;
+  trange: TTest.TRange;
+  tclass: TTest.TSomeClass;
+begin
+  trec := Default(TTest.TRecord);
+  trange := Default(TTest.TRange);
+  tclass := Default(TTest.TSomeClass);
+end.

tests/test/tdefault9.pp

@@ -0,0 +1,38 @@
+{ default can be used with generic type parameters as well }
+program tdefault9;
+
+{$mode objfpc}
+
+type
+  generic TTest<T> = class
+    f: T;
+    constructor Create;
+  end;
+
+{ TTest }
+
+constructor TTest.Create;
+begin
+  f := Default(T);
+end;
+
+type
+  TLongIntSpez = specialize TTest<LongInt>;
+  TAnsiStringSpez = specialize TTest<AnsiString>;
+  TObjectSpez = specialize TTest<TObject>;
+
+var
+  si: TLongIntSpez;
+  sa: TAnsiStringSpez;
+  so: TObjectSpez;
+begin
+  si := TLongIntSpez.Create;
+  if si.f <> 0 then
+    Halt(1);
+  sa := TAnsiStringSpez.Create;
+  if sa.f <> '' then
+    Halt(2);
+  so := TObjectSpez.Create;
+  if so.f <> Nil then
+    Halt(3);
+end.