* give an error when trying to give a parameter of a non-simple type a

    default value (mantis #22343)
  * give an error when specifying an invalid default value (e.g. a
    floating point number for a longint parameter)

git-svn-id: trunk@22021 -

.gitattributes

@@ -11766,6 +11766,9 @@ tests/webtbf/tw2174.pp svneol=native#text/plain
 tests/webtbf/tw21873.pp svneol=native#text/plain
 tests/webtbf/tw2209.pp svneol=native#text/plain
 tests/webtbf/tw22219.pp svneol=native#text/pascal
+tests/webtbf/tw22343a.pp svneol=native#text/plain
+tests/webtbf/tw22343b.pp svneol=native#text/plain
+tests/webtbf/tw22343c.pp svneol=native#text/plain
 tests/webtbf/tw22395.pp svneol=native#text/plain
 tests/webtbf/tw2242.pp svneol=native#text/plain
 tests/webtbf/tw2273.pp svneol=native#text/plain

compiler/msg/errore.msg

@@ -1449,7 +1449,7 @@ parser_e_method_lower_visibility=03322_E_Overring method "$1" cannot have a lowe
 % \end{description}
 # Type Checking
 #
-# 04117 is the last used one
+# 04119 is the last used one
 #
 % \section{Type checking errors}
 % This section lists all errors that can occur when type checking is
@@ -1868,6 +1868,9 @@ type_e_interface_lower_visibility=04117_E_The interface method "$1" has a higher
 % code compilable for the JVM target.
 type_e_typeof_requires_vmt=04118_E_TYPEOF can only be used on object types with VMT
 % Typeof() intrinsic returns pointer to VMT of its argument. It cannot be used on object types that do not have VMT.
+type_e_invalid_default_value=04119_E_It is not possible to define a default value for a parameter of type "$1"
+% Parameters declared as structured types, such as files, variants, non-dynamic
+% arrays and TP-style objects, cannot have a default value.
 % \end{description}
 #
 # Symtable

compiler/msgidx.inc

@@ -526,6 +526,7 @@ const
   type_w_interface_lower_visibility=04116;
   type_e_interface_lower_visibility=04117;
   type_e_typeof_requires_vmt=04118;
+  type_e_invalid_default_value=04119;
   sym_e_id_not_found=05000;
   sym_f_internal_error_in_symtablestack=05001;
   sym_e_duplicate_id=05002;
@@ -945,9 +946,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 66059;
+  MsgTxtSize = 66141;
 
   MsgIdxMax : array[1..20] of longint=(
-    26,92,323,119,87,56,116,26,202,63,
+    26,92,323,120,87,56,116,26,202,63,
     53,20,1,1,1,1,1,1,1,1
   );

compiler/pdecsub.pas

@@ -233,6 +233,56 @@ implementation
         explicit_paraloc,
         need_array,
         is_univ: boolean;
+
+        procedure handle_default_para_value;
+          var
+            convpd : tprocdef;
+            doconv : tconverttype;
+            nodetype : tnodetype;
+            bt : tblock_type;
+          begin
+            { only allowed for types that can be represented by a
+              constant expression }
+            if try_to_consume(_EQ) then
+             begin
+               if (hdef.typ in [recorddef,variantdef,filedef,formaldef]) or
+                  is_object(hdef) or
+                  ((hdef.typ=arraydef) and
+                   not is_dynamic_array(hdef)) then
+                 Message1(type_e_invalid_default_value,FullTypeName(hdef,nil));
+               vs:=tparavarsym(sc[0]);
+               if sc.count>1 then
+                 Message(parser_e_default_value_only_one_para);
+               bt:=block_type;
+               block_type:=bt_const;
+               { prefix 'def' to the parameter name }
+               defaultvalue:=ReadConstant('$def'+vs.name,vs.fileinfo);
+               block_type:=bt;
+               if assigned(defaultvalue) then
+                 begin
+                   include(defaultvalue.symoptions,sp_internal);
+                   pd.parast.insert(defaultvalue);
+                   { check whether the default value is of the correct
+                     type }
+                   if defaultvalue.consttyp in [conststring,constwstring] then
+                     nodetype:=stringconstn
+                   else if defaultvalue.consttyp=constnil then
+                     nodetype:=niln
+                   else
+                     nodetype:=nothingn;
+                   if compare_defs_ext(defaultvalue.constdef,hdef,nodetype,doconv,convpd,[])<=te_convert_operator then
+                     MessagePos2(defaultvalue.fileinfo,type_e_incompatible_types,FullTypeName(defaultvalue.constdef,hdef),FullTypeName(hdef,defaultvalue.constdef));
+                 end;
+               defaultrequired:=true;
+             end
+            else
+             begin
+               if defaultrequired then
+                 Message1(parser_e_default_value_expected_for_para,vs.name);
+             end;
+          end;
+
+
       begin
         old_block_type:=block_type;
         explicit_paraloc:=false;
@@ -427,27 +477,7 @@ implementation
 
                 { default parameter }
                 if (m_default_para in current_settings.modeswitches) then
-                 begin
-                   if try_to_consume(_EQ) then
-                    begin
-                      vs:=tparavarsym(sc[0]);
-                      if sc.count>1 then
-                        Message(parser_e_default_value_only_one_para);
-                      { prefix 'def' to the parameter name }
-                      defaultvalue:=ReadConstant('$def'+vs.name,vs.fileinfo);
-                      if assigned(defaultvalue) then
-                        begin
-                          include(defaultvalue.symoptions,sp_internal);
-                          pd.parast.insert(defaultvalue);
-                        end;
-                      defaultrequired:=true;
-                    end
-                   else
-                    begin
-                      if defaultrequired then
-                        Message1(parser_e_default_value_expected_for_para,vs.name);
-                    end;
-                 end;
+                  handle_default_para_value;
               end;
            end
           else

tests/webtbf/tw22343a.pp

@@ -0,0 +1,16 @@
+{ %fail }
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+
+type
+  TWrapper = record end;
+
+procedure TestProcedure(const wr: TWrapper = 0);
+  { This shouldn’t be allowed; try also 0.0, '0', nil, False, reNone, etc. }
+begin
+end;
+
+begin
+end.

tests/webtbf/tw22343b.pp

@@ -0,0 +1,22 @@
+{ %fail }
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+
+type
+  TWrapper = record
+    class operator Implicit(value: Integer): TWrapper;
+  end;
+
+class operator TWrapper.Implicit(value: Integer): TWrapper;
+begin
+end;
+
+procedure TestProcedure(const wr: TWrapper = TWrapper(0));
+  { This crashes the compiler, and shouldn’t be allowed }
+begin
+end;
+
+begin
+end.

tests/webtbf/tw22343c.pp

@@ -0,0 +1,12 @@
+{ %fail }
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+
+procedure TestProcedure(const l: longint = 1.234);
+begin
+end;
+
+begin
+end.