Add public error, expose AccPrivateCall to haxe

and make different property access error more readable

Author: RblSb

src/generators/genswf9.ml

@@ -2324,7 +2324,7 @@ let realize_required_accessors ctx cl =
 				if not (is_implemented_by_super ci) then begin
 					List.iter (fun cf ->
 						match cf.cf_kind with
-						| Var { v_read = (AccCall | AccNever) as read; v_write = (AccCall | AccNever) as write } ->
+						| Var { v_read = (AccCall | AccPrivateCall | AccNever) as read; v_write = (AccCall | AccPrivateCall | AccNever) as write } ->
 							begin try
 								let read', write', native = Hashtbl.find h cf.cf_name in
 								let read = if read = AccNever then read' else true in
@@ -2496,10 +2496,10 @@ let generate_class ctx c =
 				maybe_gen_instance_setter ctx c f acc alloc_slot
 			else
 				maybe_gen_static_setter ctx c f acc alloc_slot
-		| Var { v_read = (AccCall | AccNever) as read; v_write = (AccCall | AccNever) as write } when not (has_class_flag c CInterface) && not (Meta.has Meta.IsVar f.cf_meta) ->
+		| Var { v_read = (AccCall | AccPrivateCall | AccNever) as read; v_write = (AccCall | AccPrivateCall | AccNever) as write } when not (has_class_flag c CInterface) && not (Meta.has Meta.IsVar f.cf_meta) ->
 			(* if the accessor methods were defined in super classes, we still need to generate native getter/setter *)
 			let acc =
-				if read = AccCall then begin
+				if read = AccCall || read = AccPrivateCall then begin
 					try
 						begin
 						let tl = extract_param_types c.cl_params in
@@ -2524,7 +2524,7 @@ let generate_class ctx c =
 						acc
 				end else acc
 			in
-			if write = AccCall then begin
+			if write = AccCall || write = AccPrivateCall then begin
 				try
 					begin
 					let tl = extract_param_types c.cl_params in

src/typing/typeloadCheck.ml

@@ -385,7 +385,7 @@ module Inheritance = struct
 					if (has_class_field_flag f CfPublic) && not (has_class_field_flag f2 CfPublic) && not (Meta.has Meta.CompilerGenerated f.cf_meta) then
 						display_error com ("Field " ^ f.cf_name ^ " should be public as requested by " ^ s_type_path intf.cl_path) p
 					else if not (unify_kind ~strict:false f2.cf_kind f.cf_kind) || not (match f.cf_kind, f2.cf_kind with Var _ , Var _ -> true | Method m1, Method m2 -> mkind m1 = mkind m2 | _ -> false) then
-						display_error com ("Field " ^ f.cf_name ^ " has different property access than in " ^ s_type_path intf.cl_path ^ " (" ^ s_kind f2.cf_kind ^ " should be " ^ s_kind f.cf_kind ^ ")") p
+						display_error com ("Field " ^ f.cf_name ^ " has different property access than in " ^ s_type_path intf.cl_path ^ ": " ^ s_kind f2.cf_kind ^ " should be " ^ s_kind f.cf_kind) p
 					else try
 						let map1 = TClass.get_map_function  intf params in
 						valid_redefinition map1 map2 f2 t2 f (apply_params intf.cl_params params f.cf_type)

src/typing/typeloadFields.ml

@@ -1493,7 +1493,9 @@ let create_property (ctx,cctx,fctx) c f cf (get,set,t,eo) p =
 			display_error ctx.com (name ^ ": Custom property accessor is no longer supported, please use `set`") pset;
 			AccCall
 	) in
-	if (set = AccNever && get = AccNever)  then raise_typing_error (name ^ ": Unsupported property combination") p;
+	if (set = AccNever && get = AccNever) then raise_typing_error (name ^ ": Unsupported property combination") p;
+	if (set = AccPrivateCall && get = AccPrivateCall && has_class_field_flag cf CfPublic) then
+		raise_typing_error (name ^ ": (private get, private set) property cannot be public") p;
 	cf.cf_kind <- Var { v_read = get; v_write = set };
 	if fctx.is_extern then add_class_field_flag cf CfExtern;
 	if List.mem_assoc AEnum f.cff_access then add_class_field_flag cf CfEnum;

std/haxe/display/JsonModuleTypes.hx

@@ -213,6 +213,7 @@ enum abstract JsonVarAccessKind<T>(String) {
 	var AccNever;
 	var AccResolve;
 	var AccCall;
+	var AccPrivateCall;
 	var AccInline;
 	var AccRequire:JsonVarAccessKind<{require:String, message:Null<String>}>;
 	var AccCtor;

std/haxe/macro/Type.hx

@@ -651,6 +651,11 @@ enum VarAccess {
 	**/
 	AccCall;
 
+	/**
+		Access through private accessor function (`private get`, `private set`).
+	**/
+	AccPrivateCall;
+
 	/**
 		Inline access (`inline`).
 	**/

std/haxe/macro/TypeTools.hx

@@ -47,6 +47,7 @@ class TypeTools {
 						case AccNever: "never";
 						case AccResolve: throw "Invalid TAnonymous";
 						case AccCall: getOrSet;
+						case AccPrivateCall: 'private $getOrSet';
 						case AccInline: "default";
 						case AccRequire(_, _): "default";
 					}

tests/misc/projects/Issue3053/Main.hx

@@ -1,8 +1,14 @@
-typedef MainPrivateType = {
+typedef BadType = {
+	// should error but not yet
 	var foo(private get, private set):Int;
+	var foo2(never, never):Int;
 }
 
-typedef MainType = {
+typedef FooPrivateGetType = {
+	var foo(private get, set):Int;
+}
+
+typedef FooType = {
 	var foo(get, set):Int;
 }
 
@@ -11,14 +17,14 @@ class Main {
 		final main = new Main();
 		main.foo = 1;
 
-		var privateObj:MainPrivateType = main;
-		var obj:MainType = main; // err, should be allowed?
+		var privateObj:FooPrivateGetType = main;
+		var obj:FooType = main; // err, should be allowed?
 
 		privateObj = obj;
 		obj = privateObj; // err
 	}
 
-	public var foo(private get, private set):Int;
+	public var foo(private get, set):Int;
 
 	function get_foo():Int {
 		return 0;
@@ -28,6 +34,16 @@ class Main {
 		return v;
 	}
 
+	public var notAllowed(private get, private set):Int; // err
+
+	function set_notAllowed(value:Int):Int {
+		throw new haxe.exceptions.NotImplementedException();
+	}
+
+	function get_notAllowed():Int {
+		throw new haxe.exceptions.NotImplementedException();
+	}
+
 	public function new() {
 		foo = 1;
 		foo;
@@ -41,7 +57,7 @@ class Main {
 		rect.width;
 
 		final shape:Shape = rect;
-		shape.width = 1; // err
+		shape.width = 1;
 		shape.width; // err
 
 		final bar = new Bar();
@@ -55,11 +71,14 @@ class Main {
 		bar.width; // err
 
 		bar.defaultNull = 1; // err
+
+		final child = new Child();
+		@:privateAccess child.width = 1;
 	}
 }
 
 interface Shape {
-	var width(private get, private set):Int;
+	var width(private get, set):Int;
 }
 
 interface PublicShape {
@@ -85,7 +104,7 @@ class Rect implements Shape {
 	}
 
 	public function new() {}
-	public var width(get, private set):Int;
+	public var width(get, private set):Int; // err
 
 	function set_width(value:Int):Int {
 		return 0;
@@ -108,7 +127,7 @@ class Bar {
 		return value;
 	}
 
-	public var width(private get, private set):Int;
+	var width(private get, private set):Int;
 
 	function set_width(value:Int):Int {
 		return value;

tests/misc/projects/Issue3053/compile-fail.hxml.stderr

@@ -1,13 +1,16 @@
-Main.hx:37: characters 3-17 : This property cannot be accessed for writing
-Main.hx:40: characters 3-13 : This property cannot be accessed for writing
-Main.hx:44: characters 3-14 : This property cannot be accessed for writing
-Main.hx:45: characters 3-14 : This property cannot be accessed for reading
-Main.hx:49: characters 3-24 : This property cannot be accessed for writing
-Main.hx:54: characters 3-12 : This property cannot be accessed for writing
-Main.hx:55: characters 3-12 : This property cannot be accessed for reading
-Main.hx:57: characters 7-18 : This expression cannot be accessed for writing
-Main.hx:15: characters 3-27 : Main should be MainType
-Main.hx:15: characters 3-27 : ... Inconsistent access for field foo : (private get,private set) should be (get,set)
-Main.hx:18: characters 3-19 : MainPrivateType should be MainType
-Main.hx:18: characters 3-19 : ... Inconsistent access for field foo : (private get,private set) should be (get,set)
-Main.hx:70: characters 13-18 : Field width has different property access than in PublicShape ((get,private set) should be (get,set))
+Main.hx:37: characters 2-54 : notAllowed: (private get, private set) property cannot be public
+Main.hx:53: characters 3-17 : This property cannot be accessed for writing
+Main.hx:56: characters 3-13 : This property cannot be accessed for writing
+Main.hx:61: characters 3-14 : This property cannot be accessed for reading
+Main.hx:65: characters 3-24 : This property cannot be accessed for writing
+Main.hx:70: characters 7-12 : Cannot access private field width
+Main.hx:70: characters 3-12 : This property cannot be accessed for writing
+Main.hx:71: characters 7-12 : Cannot access private field width
+Main.hx:71: characters 3-12 : This property cannot be accessed for reading
+Main.hx:73: characters 7-18 : This expression cannot be accessed for writing
+Main.hx:21: characters 3-26 : Main should be FooType
+Main.hx:21: characters 3-26 : ... Inconsistent getter for field foo : private get should be get
+Main.hx:24: characters 3-19 : FooPrivateGetType should be FooType
+Main.hx:24: characters 3-19 : ... Inconsistent getter for field foo : private get should be get
+Main.hx:107: characters 13-18 : Field width has different property access than in Shape: (get,private set) should be (private get,set)
+Main.hx:89: characters 13-18 : Field width has different property access than in PublicShape: (get,private set) should be (get,set)

tests/misc/projects/Issue9010/InterfaceFields-fail.hxml.stderr

@@ -1,3 +1,3 @@
 InterfaceFields.hx:1: characters 7-22 : Field missing needed by IFace is missing
-InterfaceFields.hx:5: characters 18-27 : Field wrongKind has different property access than in IFace (method should be var)
-InterfaceFields.hx:4: characters 13-24 : Field wrongAccess has different property access than in IFace ((never,null) should be (default,null))
+InterfaceFields.hx:5: characters 18-27 : Field wrongKind has different property access than in IFace: method should be var
+InterfaceFields.hx:4: characters 13-24 : Field wrongAccess has different property access than in IFace: (never,null) should be (default,null)