administrator/pascalabcnet
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

bug fix #2739

Browse source
This commit is contained in:
Ivan Bondarev 2023-01-29 12:04:21 +01:00
parent 82731ee05f
commit 6b25d5943c
6 changed files with 45 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Compiler/PCU/PCUFileFormatVersion.cs
View file

@ -6,6 +6,6 @@ namespace PascalABCCompiler.PCU
{
public static class PCUFileFormatVersion
{
public static System.Int16 Version = 117;
public static System.Int16 Version = 118;
}
}

28
Compiler/PCU/PCUReader.cs
View file

@ -2096,6 +2096,7 @@ namespace PascalABCCompiler.PCU
scope = new WrappedClassScope(this, cun.scope, null);
}
ctn = new wrapped_common_type_node(this, null, name, SemanticTree.type_access_level.tal_public, cun.namespaces[0], scope, null, offset);
scope.class_type = ctn;
scope.ctn = ctn;
if (is_interface)
AddTypeToOrderList(ctn, ind);
@ -2109,15 +2110,27 @@ namespace PascalABCCompiler.PCU
AddMember(ctn, offset);
int_members.Insert(0, ctn);
SemanticTree.type_special_kind tsk = (SemanticTree.type_special_kind)br.ReadByte();
ctn.type_special_kind = tsk;
common_type_node saved_ctn = ctn;
if (ctn.full_name == "PABCSystem.BinaryFile")
ctn.type_special_kind = SemanticTree.type_special_kind.binary_file;
if (ctn.type_special_kind != SemanticTree.type_special_kind.set_type)
{
SystemLibrary.SystemLibrary.init_reference_type(ctn);
}
type_node base_type = GetTypeReference();
bool is_value_type = br.ReadBoolean();
ctn.SetBaseType(base_type);
ctn.internal_is_value = is_value_type;
List<SemanticTree.ITypeNode> interf_implemented = ReadImplementingInterfaces();
constant_node low_val = null;
constant_node upper_val = null;
SemanticTree.type_access_level tal = (SemanticTree.type_access_level)br.ReadByte();
SemanticTree.type_special_kind tsk = (SemanticTree.type_special_kind)br.ReadByte();
ctn.SetIsSealed(br.ReadBoolean());
ctn.SetIsAbstract(br.ReadBoolean(), null); // Причина null, потому что проблема пересечения sealed и abstract не может произойти после загрузки из .pcu
ctn.SetIsStatic(br.ReadBoolean());
@ -2139,19 +2152,12 @@ namespace PascalABCCompiler.PCU
}
iscope.TopInterfaceScopeArray = interf_scopes.ToArray();
}
ctn.SetBaseType(base_type);
ctn.IsInterface = type_is_interface;
ctn.IsDelegate = type_is_delegate;
ctn.is_class = type_is_class;
ctn.ImplementingInterfaces.AddRange(interf_implemented);
ctn.internal_is_value = is_value_type;
ctn.type_special_kind = tsk;
if (ctn.full_name == "PABCSystem.BinaryFile")
ctn.type_special_kind = SemanticTree.type_special_kind.binary_file;
if (ctn.type_special_kind != SemanticTree.type_special_kind.set_type)
{
SystemLibrary.SystemLibrary.init_reference_type(ctn);
}
if (type_is_generic_definition)
{
foreach (common_type_node par in type_params)

4
Compiler/PCU/PCUWriter.cs
View file

@ -2618,7 +2618,7 @@ namespace PascalABCCompiler.PCU
{
bw.Write((byte)0);
}
bw.Write((byte)type.type_special_kind);
int base_class_off = (int)bw.BaseStream.Position;
bw.Seek(GetSizeOfReference(type.base_type), SeekOrigin.Current);
@ -2634,7 +2634,7 @@ namespace PascalABCCompiler.PCU
seek_off += GetSizeOfReference(type.ImplementingInterfaces[k] as TreeRealization.type_node);
bw.Seek(seek_off, SeekOrigin.Current);
bw.Write((byte)type.type_access_level);
bw.Write((byte)type.type_special_kind);
bw.Write(type.IsSealed);
bw.Write(type.IsAbstract);
bw.Write(type.IsStatic);

2
TestSuite/implement1.pas
View file

@ -1,4 +1,4 @@
uses implement1u;
uses implement1u;
type TClass = class(System._AppDomain)

19
TestSuite/units/u_generics13.pas Normal file
View file

@ -0,0 +1,19 @@
unit u_generics13;
type
t1<T> = class end;
t2<T1, T2> = class(t1<t2<T1, T2>>) end;
t3 = class end;
t5 = class end;
t4 = class
static procedure p1<T1, T2>;
begin
new t2<T1, T2>;
end;
end;
end.

5
TestSuite/usesunits/use_generics13.pas Normal file
View file

@ -0,0 +1,5 @@
uses u_generics13;
begin
t4.p1&<t3, t5>;
end.