fix #2640

TestSuite/override-where.pas

@@ -0,0 +1,58 @@
+// issue#2640
+type
+  CustomClass = class public x := 5; end;
+  EnumSynonym = System.Enum;
+  
+  t1 = class
+    
+    procedure OK1<T>(o: T); virtual; where T: CustomClass; begin Writeln(o) end;
+    
+    procedure OK2<T>(o: T); virtual; where T: CustomClass, constructor; begin Writeln(o) end;
+    
+    procedure OK3<T>(o: T); virtual; where T: CustomClass, constructor; begin Writeln(o) end;
+    
+    procedure OK4<T>(o: T); virtual; where T: CustomClass; begin Writeln(o) end;
+    
+    procedure OK5<T>(o: T); virtual; where T: EnumSynonym, record; begin Writeln(o) end;
+    
+  end;
+  t2 = class(t1)
+    
+    procedure OK1<T>(o: T); override; begin Writeln(o) end;
+    
+    procedure OK2<T>(o: T); override; where T: CustomClass; begin Writeln(o) end;
+    
+    procedure OK3<T>(o: T); override; where T: constructor; begin Writeln(o) end;
+    
+    procedure OK4<T>(o: T); override; where T: class; begin Writeln(o) end;
+    
+    procedure OK5<T>(o: T); override; where T: record; begin Writeln(o) end;
+    
+  end;
+  
+begin
+  var a := new t1;
+  var b := new t2;
+  
+  a.OK1(new CustomClass);
+  b.OK1(0);
+  Writeln('~'*30);
+  
+  a.OK2(new CustomClass);
+  b.OK2(new CustomClass);
+  Writeln('~'*30);
+  
+  a.OK3(new CustomClass);
+  b.OK3(new object);
+  Writeln('~'*30);
+  
+  a.OK4(new CustomClass);
+  b.OK4(new object);
+  Writeln('~'*30);
+  
+  var my_enum: (ME_1, ME_2);
+  a.OK5(my_enum);
+  b.OK5(my_enum);
+  Writeln('~'*30);
+  
+end.

TreeConverter/LambdaExpressions/Closure/CapturedVariablesSubstitutor.cs

@@ -1056,23 +1056,23 @@ namespace TreeConverter.LambdaExpressions.Closure
                     types = new where_type_specificator_list()
                 };
 
-                if (el.is_class)
+                if (el.base_class != null && el.base_class != SystemLibrary.object_type)
+                {
+                    var d = LambdaHelper.ConvertSemanticTypeToSyntaxType(el.base_class);
+                    whereDef.types.Add(d);
+                }
+                else if (el.is_class)
                 {
                     var d = new declaration_specificator(DeclarationSpecificator.WhereDefClass, "class");
                     whereDef.types.Add(d);
                 }
+
                 if (el.is_value)
                 {
                     var d = new declaration_specificator(DeclarationSpecificator.WhereDefValueType, "record");
                     whereDef.types.Add(d);
                 }
 
-                if (el.base_class != null && el.base_class != SystemLibrary.object_type)
-                {
-                    var d = LambdaHelper.ConvertSemanticTypeToSyntaxType(el.base_class);
-                    whereDef.types.Add(d);
-                }
-
                 foreach (var interf in el.implementing_interfaces)
                 {
                     var d = LambdaHelper.ConvertSemanticTypeToSyntaxType(interf);

TreeConverter/TreeConversion/syntax_tree_visitor.cs

@@ -12925,6 +12925,12 @@ namespace PascalABCCompiler.TreeConverter
         private void add_generic_eliminations(common_type_node param, List<SyntaxTree.type_definition> specificators)
         {
             Hashtable used_interfs = new Hashtable();
+            // System.Enum это класс, но его наследники - записи
+            // Если указать "where T: Enum, record" - станет нельзя применять T=Enum, с ошибкой что Enum не запись
+            // Но чтобы в секции where override метода можно было указать record без System.Enum
+            // И чтобы можно было передавать конкретные энумы (которые записи), когда record не указан во where
+            // Разрешил стрелять себе в ногу, указывая Enum вместе с record или class
+            var base_is_enum = false;
             for (int i = 0; i < specificators.Count; ++i)
             {
                 SyntaxTree.declaration_specificator ds = specificators[i] as SyntaxTree.declaration_specificator;
@@ -12933,7 +12939,7 @@ namespace PascalABCCompiler.TreeConverter
                     switch (ds.specificator)
                     {
                         case SyntaxTree.DeclarationSpecificator.WhereDefClass:
-                            if (i == 0)
+                            if (i == 0 || i == 1 && base_is_enum)
                             {
                                 param.is_class = true;
                             }
@@ -12943,7 +12949,7 @@ namespace PascalABCCompiler.TreeConverter
                             }
                             break;
                         case SyntaxTree.DeclarationSpecificator.WhereDefValueType:
-                            if (i == 0)
+                            if (i == 0 || i == 1 && base_is_enum)
                             {
                                 param.internal_is_value = true;
                             }
@@ -13014,6 +13020,10 @@ namespace PascalABCCompiler.TreeConverter
                                     AddError(get_location(specificators[i]), "STATIC_CLASS_CAN_NOT_BE_USED_AS_PARENT_SPECIFICATOR");
                                 check_cycle_inheritance(param, spec_type);
                                 param.SetBaseType(spec_type);
+                                base_is_enum = spec_type == SystemLibrary.SystemLibrary.enum_base_type;
+                                // Чтобы в секции where override метода можно было указать class вместо конкретного типа
+                                // Иначе CLR падает с TypeLoadException
+                                if (!base_is_enum) param.is_class = true;
                             }
                         }
                     }
@@ -14236,8 +14246,32 @@ namespace PascalABCCompiler.TreeConverter
                                 cmn.polymorphic_state = SemanticTree.polymorphic_state.ps_virtual_abstract;
                                 
                             }
-                            if (is_override && _procedure_attributes_list.Parent is procedure_header ph && ph.where_defs != null)
+                            if (is_override && (_procedure_attributes_list.Parent as procedure_header)?.where_defs is where_definition_list where_node)
-                                AddError(cmn.loc, "OVERRIDE_METHODS_CANNOT_CONTAIN_WHERE_SECTION");
+                            {
+                                var where_loc = get_location(where_node);
+
+                                var gen_pars1 = cmn.overrided_method.get_generic_params_list();
+                                var gen_pars2 = cmn.get_generic_params_list();
+                                System.Diagnostics.Debug.Assert(gen_pars1.Count == gen_pars2.Count);
+
+                                for (int par_i = 0; par_i < gen_pars1.Count; par_i++)
+                                {
+                                    var gen_par1 = gen_pars1[par_i] as common_type_node;
+                                    var gen_par2 = gen_pars2[par_i] as common_type_node;
+
+                                    if (gen_par2.base_type != SystemLibrary.SystemLibrary.object_type && !convertion_data_and_alghoritms.eq_type_nodes(gen_par2.base_type, gen_par1.base_type, true))
+                                        AddError(where_loc, "OVERRIDE_WHERE_TYPE_MUST_BE_SAME", gen_par2.name, gen_par1.base_type.PrintableName);
+
+                                    if (gen_par2.has_explicit_default_constructor && !gen_par1.has_explicit_default_constructor)
+                                        AddError(where_loc, "OVERRIDE_WHERE_UNEXPECTED_X", gen_par2.name, "constructor");
+                                    if (gen_par2.is_class && !gen_par1.is_class)
+                                        AddError(where_loc, "OVERRIDE_WHERE_UNEXPECTED_X", gen_par2.name, "class");
+                                    if (gen_par2.is_value && !gen_par1.is_value)
+                                        AddError(where_loc, "OVERRIDE_WHERE_UNEXPECTED_X", gen_par2.name, "record");
+
+                                }
+
+                            }
 
                             if (cmn.field_access_level < cmn.overrided_method.field_access_level)
                                 AddError(cmn.loc, "CAN_NOT_BE_DOWN_ACCESS_LEVEL_FOR_METH");

TreeConverter/TreeRealization/generics.cs

@@ -153,14 +153,6 @@ namespace PascalABCCompiler.TreeRealization
                 generic_parameter_eliminations gpe = gpe_list[i];
                 type_node tn = tparams[i];
                 
-                if (gpe.is_class && !tn.is_class && !(tn.is_generic_parameter && tn.base_type != null && tn.base_type.is_class))
-                {
-                    return new SimpleSemanticError(null, "PARAMETER_{0}_MUST_BE_REFERENCE_TYPE", tn.PrintableName);
-                }
-                if (gpe.is_value && (!tn.is_value || tn.BaseFullName != null && tn.BaseFullName.StartsWith("System.Nullable")) /*&& !tn.is_generic_parameter*/)
-                {
-                    return new SimpleSemanticError(null, "PARAMETER_{0}_MUST_BE_VALUE_TYPE", tn.PrintableName);
-                }
                 if (gpe.base_class != null && gpe.base_class != SystemLibrary.SystemLibrary.object_type && !tn.is_value)
                 {
                     type_node base_type = generic_convertions.determine_type(gpe.base_class, tparams, method_param_types);
@@ -172,6 +164,14 @@ namespace PascalABCCompiler.TreeRealization
                         return new SimpleSemanticError(null, "PARAMETER_{0}_MUST_BE_DERIVED_FROM_{1}", tn.PrintableName, base_type.name);
                     }
                 }
+                if (gpe.is_class && !tn.is_class && !(tn.is_generic_parameter && tn.base_type != null && tn.base_type.is_class))
+                {
+                    return new SimpleSemanticError(null, "PARAMETER_{0}_MUST_BE_REFERENCE_TYPE", tn.PrintableName);
+                }
+                if (gpe.is_value && (!tn.is_value || tn.BaseFullName != null && tn.BaseFullName.StartsWith("System.Nullable")) /*&& !tn.is_generic_parameter*/)
+                {
+                    return new SimpleSemanticError(null, "PARAMETER_{0}_MUST_BE_VALUE_TYPE", tn.PrintableName);
+                }
                 if (gpe.base_class != null && gpe.base_class != SystemLibrary.SystemLibrary.object_type && tn.is_value && !gpe.base_class.is_value && gpe.base_class != SystemLibrary.SystemLibrary.value_type && gpe.base_class != SystemLibrary.SystemLibrary.enum_base_type)
                 {
                     return new SimpleSemanticError(null, "PARAMETER_{0}_MUST_BE_REFERENCE_TYPE", tn.PrintableName);

bin/Lng/Eng/SemanticErrors_ms.dat

@@ -39,8 +39,8 @@ PROCEDURE_TYPE_SHOULD_BE_REPLACED_BY_TYPE_NAME_IN_THIS_CONTEXT=Procedure type sh
 ACCESS_TO_ENUM_CONST_THROUGH_OBJECT=Enum constant can not be accessed through an object
 ONE_DIM_ARRAY_OR_LIST_EXPECTED=One-dimensional array or list expected
 TUPLE_TYPE_ELEMENTS_COUNT_MUST_BE_LESSEQUAL_7=Number of elements in tuple type must be less than 8
-OVERRIDE_METHODS_CANNOT_CONTAIN_WHERE_SECTION=Methods with override modifier can't contain where section
+OVERRIDE_WHERE_TYPE_MUST_BE_SAME=Where section of inhereted method expects generic parameter {0} to inherete from exactly {1}
-Ìåòîäû ñ ìîäèôèêàòîðîì override íå ìîãóò ñîäåðæàòü ñîáñòâåííóþ ñåêöèþ where
+OVERRIDE_WHERE_UNEXPECTED_X=Where section of inhereted method for generic parameter {0} didn't have {1} specifier
 EXPLICIT_CASTS_FOR_LAMBDA_EXPRESSIONS_ARE_FORBIDDEN=Explicit type casts for lambda expressions are forbidden
 STATIC_CLASS_CANNOT_HAVE_PREDEFINITION=Static class cannot be predefined
 OPERATIONS_CANNOT_BE_CALLED_USING_THIS_SYNTAX=Operations cannot be called using this syntax

bin/Lng/Rus/SemanticErrors_ms.dat

@@ -40,7 +40,8 @@ PROCEDURE_TYPE_SHOULD_BE_REPLACED_BY_TYPE_NAME_IN_THIS_CONTEXT=Процедур
 ACCESS_TO_ENUM_CONST_THROUGH_OBJECT=Нельзя обратиться к элементу перечисления через объект
 ONE_DIM_ARRAY_OR_LIST_EXPECTED=Ожидался одномерный массив или список
 TUPLE_TYPE_ELEMENTS_COUNT_MUST_BE_LESSEQUAL_7=Количество элементов в типе кортежа не должно быть больше 7
-OVERRIDE_METHODS_CANNOT_CONTAIN_WHERE_SECTION=Методы с модификатором override не могут содержать собственную секцию where
+OVERRIDE_WHERE_TYPE_MUST_BE_SAME=Секция where метода предка ожидает что шаблонный параметр {0} будет наследовать от именно {1}
+OVERRIDE_WHERE_UNEXPECTED_X=Секция where метода предка для шаблонного параметра {0} не имела спецификатора {1}
 EXPLICIT_CASTS_FOR_LAMBDA_EXPRESSIONS_ARE_FORBIDDEN=Явные приведения типов для лямбда-выражений запрещены
 STATIC_CLASS_CANNOT_HAVE_PREDEFINITION=Статический класс не может иметь предописание
 OPERATIONS_CANNOT_BE_CALLED_USING_THIS_SYNTAX=Операции нельзя вызывать, используя данный синтаксис