Skip to content

Commit

Permalink
Merge branch 'pascalabcnet:master' into test
Browse files Browse the repository at this point in the history
  • Loading branch information
@spectatorBH
spectatorBH authored Sep 19, 2023
2 parents 975cdcd + ddd5cb8 commit 9519e3b
Show file tree
Hide file tree
Showing 13 changed files with 474 additions and 500 deletions.
2 changes: 1 addition & 1 deletion Configuration/GlobalAssemblyInfo.cs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,7 @@ internal static class RevisionClass
public const string Major = "3";
public const string Minor = "9";
public const string Build = "0";
public const string Revision = "3351";
public const string Revision = "3358";

public const string MainVersion = Major + "." + Minor;
public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision;
Expand Down
4 changes: 2 additions & 2 deletions Configuration/Version.defs
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
%MINOR%=9
%REVISION%=3351
%COREVERSION%=0
%REVISION%=3358
%MINOR%=9
%MAJOR%=3
2 changes: 1 addition & 1 deletion Release/pabcversion.txt
View file
Original file line number Diff line number Diff line change
@@ -1 +1 @@
3.9.0.3351
3.9.0.3358
2 changes: 1 addition & 1 deletion ReleaseGenerators/PascalABCNET_version.nsh
View file
Original file line number Diff line number Diff line change
@@ -1 +1 @@
!define VERSION '3.9.0.3351'
!define VERSION '3.9.0.3358'
314 changes: 169 additions & 145 deletions TestSuite/CompilationSamples/School.pas
View file

Large diffs are not rendered by default.

3 changes: 3 additions & 0 deletions TestSuite/SingleReal.pas
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
begin
Assert(Arr(1.0,2.0).Sum(x -> x*x).GetType = typeof(real))
end.
11 changes: 11 additions & 0 deletions TestSuite/check_sequence.pas
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,11 @@
procedure CheckOutputSeq(a: sequence of integer);
begin
end;

procedure CheckOutputSeq(a: sequence of object);
begin
end;

begin
CheckOutputSeq(Arr(1,2,3));
end.
16 changes: 14 additions & 2 deletions TreeConverter/TreeRealization/type_table.cs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -575,8 +575,8 @@ public static bool is_derived(type_node base_class, type_node derived_class, boo
// Но без этой строчки не работает преобразование sequence of Student к sequence of Person и sequence of object
// SSM 19/07/23 - снова раскомментировал - теперь не работало
// CheckOutputSeq(a); в Tasks где var a: array of char
if (tnode.IsInterface)
ImplementingInterfaces.Add(tnode);
//if (tnode.IsInterface) // SSM закомментировал опять 17.09.23 - single - неточные вычисления!
// ImplementingInterfaces.Add(tnode);
foreach (var interf in ImplementingInterfaces)
{
var ctn = interf as compiled_type_node;
Expand Down Expand Up @@ -809,6 +809,18 @@ public static type_compare compare_types_in_specific_order(type_node left, type_
public static type_compare compare_types(type_node left, type_node right)
{
type_compare ret = get_table_type_compare(left, right);
// SSM 18.09.23 исправление #2872 (частное!!! только первый параметр!)
var ctnl = left as compiled_type_node;
var ctnr = right as compiled_type_node;
if (ctnl != null && ctnr != null && ctnl.original_generic == ctnr.original_generic
&& ctnl.compiled_type.IsInterface && ctnl.generic_params != null && ctnl.generic_params.Count == 1)
{
var interf_compiled_type = (ctnr.original_generic as compiled_type_node).compiled_type;
if ((interf_compiled_type.GetGenericArguments()[0].GenericParameterAttributes & System.Reflection.GenericParameterAttributes.Covariant) != 0)
return compare_types(ctnl.generic_params[0], ctnr.generic_params[0]);
}
// IEnumerable<object> д.б. < IEnumerable<integer>
// Проверить, что оба - IEnumerable. И если object < integer, то вернуть type_compare.less_type
if (ret != type_compare.non_comparable_type)
{
return ret;
Expand Down
1 change: 0 additions & 1 deletion VisualPascalABCNETLinux/IB/Debugger/Debugger.cs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1097,7 +1097,6 @@ private void JumpToCurrentLine(bool fromBreakpoint = false)
bool in_comm = false;
bool beg = false;
bool in_str = false;
Console.WriteLine("2 jump to " + stackFrame.SourceLocation.FileName + ":" + stackFrame.SourceLocation.Line);

for (int i = 0; i < lseg.Words.Count; i++)
{
Expand Down
217 changes: 48 additions & 169 deletions VisualPascalABCNETLinux/IB/Debugger/ExpressionEvaluation.cs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6298,37 +6298,42 @@ public override void visit(indexer _indexer)
names.Add("]");
if (rv.monoValue != null)
{
if (rv.obj_val is MemberValue && (rv.obj_val as MemberValue).MemberInfo is PropertyInfo)

RetValue res = new RetValue();
Type type = AssemblyHelper.GetType(rv.monoValue.TypeName);
if (type != null && type.GetField("NullBasedArray") != null)
{
PropertyInfo pi = (rv.obj_val as MemberValue).MemberInfo as PropertyInfo;
Type t = AssemblyHelper.GetType(last_obj.Type.FullName);
System.Reflection.PropertyInfo rpi = t.GetProperty(pi.Name, System.Reflection.BindingFlags.NonPublic | System.Reflection.BindingFlags.Public | System.Reflection.BindingFlags.Static | System.Reflection.BindingFlags.Instance);
/*System.Reflection.MemberInfo[] props = t.GetMembers(System.Reflection.BindingFlags.NonPublic|System.Reflection.BindingFlags.Public|System.Reflection.BindingFlags.Static|System.Reflection.BindingFlags.CreateInstance);
System.Reflection.PropertyInfo rpi = null;
foreach (System.Reflection.MemberInfo p in props)
if (p is System.Reflection.PropertyInfo && p.Name == pi.Name)
int low_bound = 0;
System.Reflection.FieldInfo fi = type.GetField("LowerIndex");
low_bound = Convert.ToInt32(fi.GetRawConstantValue());
int[] tmp_indices = new int[1];
int j = 0;
try
{
rpi = p as System.Reflection.PropertyInfo;
break;
}*/
RetValue res = new RetValue();
res.obj_val = ((rv.obj_val as MemberValue).MemberInfo as PropertyInfo).GetValue(last_obj,
get_val_arr(indices, false, rpi.GetGetMethod(true)));
eval_stack.Push(res);
return;
}
if (true)
{

RetValue res = new RetValue();
Type type = AssemblyHelper.GetType(rv.monoValue.TypeName);
if (type != null && type.GetField("NullBasedArray") != null)
object obj = indices[j++];
int v = 0;
if (obj is Value && DebugUtils.IsEnum(obj as Value, out v))
tmp_indices[0] = v - low_bound;
else
tmp_indices[0] = Convert.ToInt32(obj) - low_bound;
}
catch (System.FormatException)
{
int low_bound = 0;
System.Reflection.FieldInfo fi = type.GetField("LowerIndex");
low_bound = Convert.ToInt32(fi.GetRawConstantValue());
int[] tmp_indices = new int[1];
int j = 0;
throw new WrongTypeInIndexer();
}
catch (System.InvalidCastException)
{
throw new WrongTypeInIndexer();
}
//res.obj_val = cur_mi.Invoke(rv.obj_val,indices.ToArray()) as NamedValue;
var nv = rv.monoValue.GetChild("NullBasedArray");
res.monoValue = nv.GetRangeOfChildren(tmp_indices[0], 1)[0];
check_for_out_of_range(res.obj_val);
nv = res.monoValue.GetChild("NullBasedArray");
while (nv != null && j < indices.Count)
{
System.Reflection.FieldInfo tmp_fi = AssemblyHelper.GetType(res.monoValue.TypeName).GetField("LowerIndex");
low_bound = Convert.ToInt32(tmp_fi.GetRawConstantValue());
try
{
object obj = indices[j++];
Expand All @@ -6346,162 +6351,36 @@ public override void visit(indexer _indexer)
{
throw new WrongTypeInIndexer();
}
//res.obj_val = cur_mi.Invoke(rv.obj_val,indices.ToArray()) as NamedValue;
var nv = rv.monoValue.GetChild("NullBasedArray");
res.monoValue = nv.GetRangeOfChildren(tmp_indices[0], 1)[0];
check_for_out_of_range(res.obj_val);
nv = res.monoValue.GetChild("NullBasedArray");
while (nv != null && j < indices.Count)
{
System.Reflection.FieldInfo tmp_fi = AssemblyHelper.GetType(res.monoValue.TypeName).GetField("LowerIndex");
low_bound = Convert.ToInt32(tmp_fi.GetRawConstantValue());
try
{
object obj = indices[j++];
int v = 0;
if (obj is Value && DebugUtils.IsEnum(obj as Value, out v))
tmp_indices[0] = v - low_bound;
else
tmp_indices[0] = Convert.ToInt32(obj) - low_bound;
}
catch (System.FormatException)
{
throw new WrongTypeInIndexer();
}
catch (System.InvalidCastException)
{
throw new WrongTypeInIndexer();
}
res.monoValue = nv.GetRangeOfChildren(tmp_indices[0], 1)[0];
check_for_out_of_range(res.obj_val);
nv = res.monoValue.GetChild("NullBasedArray");

}
if (j < indices.Count)
throw new WrongIndexersNumber();
eval_stack.Push(res);
}
else
res.monoValue = rv.monoValue.GetRangeOfChildren(conv_to_int_arr(indices)[0], 1)[0];
//check_for_out_of_range(res.monoValue);
if (j < indices.Count)
throw new WrongIndexersNumber();
eval_stack.Push(res);

}
else
{
IList<MemberInfo> mis = rv.obj_val.Type.GetMember("get_val", BindingFlags.All);
if (mis.Count > 0)
var tm = rv.monoValue.Type as Mono.Debugger.Soft.TypeMirror;
var mi = tm.GetMethod("get_Item");
if (mi != null)
{
MethodInfo cur_mi = null;
int low_bound = 0;
foreach (MemberInfo mi in mis)
List<Mono.Debugging.Client.ObjectValue> ind_list = new List<Mono.Debugging.Client.ObjectValue>();
foreach (var ind in indices)
{
if (mi is MethodInfo)
{
cur_mi = mi as MethodInfo;
//FieldInfo fi = rv.obj_val.Type.GetMember("LowerIndex",BindingFlags.All)[0] as FieldInfo;
System.Reflection.FieldInfo fi = AssemblyHelper.GetType(rv.obj_val.Type.FullName).GetField("LowerIndex");
low_bound = Convert.ToInt32(fi.GetRawConstantValue());
}
ind_list.Add(DebugUtils.MakeMonoValue(ind));
}
RetValue res = new RetValue();
uint[] tmp_indices = new uint[1];
int j = 0;
try
{
object obj = indices[j++];
int v = 0;
if (obj is Value && DebugUtils.IsEnum(obj as Value, out v))
tmp_indices[0] = (uint)(v - low_bound);
else
tmp_indices[0] = (uint)(Convert.ToInt32(obj) - low_bound);
}
catch (System.FormatException)
{
throw new WrongTypeInIndexer();
}
catch (System.InvalidCastException)
{
throw new WrongTypeInIndexer();
}
//res.obj_val = cur_mi.Invoke(rv.obj_val,indices.ToArray()) as NamedValue;
Value nv = rv.obj_val.GetMember("NullBasedArray");
res.obj_val = nv.GetArrayElement(tmp_indices);
check_for_out_of_range(res.obj_val);
nv = res.obj_val.GetMember("NullBasedArray");
while (nv != null && j < indices.Count)
{
System.Reflection.FieldInfo tmp_fi = AssemblyHelper.GetType(res.obj_val.Type.FullName).GetField("LowerIndex");
low_bound = Convert.ToInt32(tmp_fi.GetRawConstantValue());
try
{
object obj = indices[j++];
int v = 0;
if (obj is Value && DebugUtils.IsEnum(obj as Value, out v))
tmp_indices[0] = (uint)(v - low_bound);
else
tmp_indices[0] = (uint)(Convert.ToInt32(obj) - low_bound);
}
catch (System.FormatException)
{
throw new WrongTypeInIndexer();
}
catch (System.InvalidCastException)
{
throw new WrongTypeInIndexer();
}
res.obj_val = nv.GetArrayElement(tmp_indices);
check_for_out_of_range(res.obj_val);
nv = res.obj_val.GetMember("NullBasedArray");

}
if (j < indices.Count)
throw new WrongIndexersNumber();
eval_stack.Push(res);
res.monoValue = InvokeMethod(tm, mi, rv.monoValue, ind_list.ToArray());
}
else
{
string name = get_type_name(rv.obj_val.Type);
Type t = AssemblyHelper.GetType(name);
if (t == null && declaringType != null)
t = AssemblyHelper.GetType(declaringType.FullName + "+" + name);
DebugType[] gen_args = rv.obj_val.Type.GetGenericArguments();
if (gen_args.Length > 0)
{
List<Type> gens = new List<Type>();
for (int i = 0; i < gen_args.Length; i++)
gens.Add(AssemblyHelper.GetType(get_type_name(gen_args[i])));
t = t.MakeGenericType(gens.ToArray());
}
System.Reflection.MemberInfo[] def_members = t.GetDefaultMembers();
System.Reflection.PropertyInfo _default_property = null;
if (def_members != null && def_members.Length > 0)
{
foreach (System.Reflection.MemberInfo mi in def_members)
{
System.Reflection.PropertyInfo pi = mi as System.Reflection.PropertyInfo;
if (pi != null)
{
_default_property = pi;
break;
}
}
}
if (_default_property != null)
{
if (_default_property.GetGetMethod().GetParameters().Length != indices.Count)
throw new WrongIndexersNumber();
MethodInfo mi2 = rv.obj_val.Type.GetMember(_default_property.GetGetMethod().Name, Debugger.BindingFlags.All)[0] as MethodInfo;
RetValue res = new RetValue();
res.obj_val = mi2.Invoke(rv.obj_val, get_val_arr(indices, _default_property.DeclaringType == typeof(string), _default_property.GetGetMethod()));
check_for_out_of_range(res.obj_val);
eval_stack.Push(res);
}
else
throw new NoIndexerProperty();

}
res.monoValue = rv.monoValue.GetRangeOfChildren(conv_to_int_arr(indices)[0], 1)[0];
}

//check_for_out_of_range(res.monoValue);
eval_stack.Push(res);


}
}

Expand Down
24 changes: 21 additions & 3 deletions VisualPascalABCNETLinux/MonoDebugging/Client/ObjectValue.cs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -67,11 +67,29 @@ public class ObjectValue

[NonSerialized]
StackFrame parentFrame;
static ObjectValue Create (IObjectValueSource source, ObjectPath path, string typeName)

static ObjectValue Create(IObjectValueSource source, ObjectPath path, string typeName)
{
var val = new ObjectValue ();
var val = new ObjectValue();
val.typeName = typeName;
int ptr_ind = val.typeName.IndexOf('*');
string ptr = "";
if (ptr_ind != -1)
ptr = val.typeName.Substring(ptr_ind).Replace('*', '^');
switch (val.typeName.Replace("*",""))
{
case "int": val.typeName = "integer"; break;
case "double": val.typeName = "real"; break;
case "float": val.typeName = "single"; break;
case "uint": val.typeName = "longword"; break;
case "long": val.typeName = "int64"; break;
case "ulong": val.typeName = "uint64"; break;
case "short": val.typeName = "smallint"; break;
case "ushort": val.typeName = "word"; break;
case "sbyte": val.typeName = "shortint"; break;
case "bool": val.typeName = "boolean"; break;
}
val.typeName = ptr+val.typeName.Replace("*", "");
val.source = source;
val.path = path;
return val;
Expand Down
Loading

0 comments on commit 9519e3b

Please sign in to comment.