diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/decl.c | 64 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/specs/limited_with4.ads | 23 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/specs/limited_with4_pkg.ads | 15 | 
5 files changed, 104 insertions, 8 deletions
| diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5d39ca7..db9eebc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,10 @@  2012-10-22  Eric Botcazou  <ebotcazou@adacore.com> +	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Subprogram_Type>: In +	type annotation mode, break circularities introduced by AI05-0151. + +2012-10-22  Eric Botcazou  <ebotcazou@adacore.com> +  	* gcc-interface/trans.c (Loop_Statement_to_gnu): Use gnat_type_for_size  	directly to obtain an unsigned version of the base type. diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index cb40ee6..3e0d733 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -4142,7 +4142,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)  	  gnu_return_type = void_type_node;  	else  	  { -	    gnu_return_type = gnat_to_gnu_type (gnat_return_type); +	    /* Ada 2012 (AI05-0151): Incomplete types coming from a limited +	       context may now appear in parameter and result profiles.  If +	       we are only annotating types, break circularities here.  */ +	    if (type_annotate_only +		&& IN (Ekind (gnat_return_type), Incomplete_Kind) +	        && From_With_Type (gnat_return_type) +		&& In_Extended_Main_Code_Unit +		   (Non_Limited_View (gnat_return_type)) +		&& !present_gnu_tree (Non_Limited_View (gnat_return_type))) +	      gnu_return_type = ptr_void_type_node; +	    else +	      gnu_return_type = gnat_to_gnu_type (gnat_return_type);  	    /* If this function returns by reference, make the actual return  	       type the pointer type and make a note of that.  */ @@ -4238,11 +4249,30 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)  	     Present (gnat_param);  	     gnat_param = Next_Formal_With_Extras (gnat_param), parmnum++)  	  { +	    Entity_Id gnat_param_type = Etype (gnat_param);  	    tree gnu_param_name = get_entity_name (gnat_param); -	    tree gnu_param_type = gnat_to_gnu_type (Etype (gnat_param)); -	    tree gnu_param, gnu_field; -	    bool copy_in_copy_out = false; +	    tree gnu_param_type, gnu_param, gnu_field;  	    Mechanism_Type mech = Mechanism (gnat_param); +  	    bool copy_in_copy_out = false, fake_param_type; + +	    /* Ada 2012 (AI05-0151): Incomplete types coming from a limited +	       context may now appear in parameter and result profiles.  If +	       we are only annotating types, break circularities here.  */ +	    if (type_annotate_only +		&& IN (Ekind (gnat_param_type), Incomplete_Kind) +	        && From_With_Type (Etype (gnat_param_type)) +		&& In_Extended_Main_Code_Unit +		   (Non_Limited_View (gnat_param_type)) +		&& !present_gnu_tree (Non_Limited_View (gnat_param_type))) +	      { +		gnu_param_type = ptr_void_type_node; +		fake_param_type = true; +	      } +	    else +	      { +		gnu_param_type = gnat_to_gnu_type (gnat_param_type); +		fake_param_type = false; +	      }  	    /* Builtins are expanded inline and there is no real call sequence  	       involved.  So the type expected by the underlying expander is @@ -4280,10 +4310,28 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)  		mech = Default;  	      } -	    gnu_param -	      = gnat_to_gnu_param (gnat_param, mech, gnat_entity, -				   Has_Foreign_Convention (gnat_entity), -				   ©_in_copy_out); +	    /* Do not call gnat_to_gnu_param for a fake parameter type since +	       it will try to use the real type again.  */ +	    if (fake_param_type) +	      { +		if (Ekind (gnat_param) == E_Out_Parameter) +		  gnu_param = NULL_TREE; +		else +		  { +		    gnu_param +		      = create_param_decl (gnu_param_name, gnu_param_type, +					   false); +		    Set_Mechanism (gnat_param, +				   mech == Default ? By_Copy : mech); +		    if (Ekind (gnat_param) == E_In_Out_Parameter) +		      copy_in_copy_out = true; +		  } +	      } +	    else +	      gnu_param +		= gnat_to_gnu_param (gnat_param, mech, gnat_entity, +				     Has_Foreign_Convention (gnat_entity), +				     ©_in_copy_out);  	    /* We are returned either a PARM_DECL or a type if no parameter  	       needs to be passed; in either case, adjust the type.  */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index dbe23bf..2d514d2 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,10 @@  2012-10-22  Eric Botcazou  <ebotcazou@adacore.com> +	* gnat.dg/specs/limited_with4.ads: New test. +	* gnat.dg/specs/limited_with4_pkg.ads: New helper. + +2012-10-22  Eric Botcazou  <ebotcazou@adacore.com> +  	* gnat.dg/modular4.adb: New test.  	* gnat.dg/modular4_pkg.ads: New helper. diff --git a/gcc/testsuite/gnat.dg/specs/limited_with4.ads b/gcc/testsuite/gnat.dg/specs/limited_with4.ads new file mode 100644 index 0000000..e182571 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/limited_with4.ads @@ -0,0 +1,23 @@ +-- { dg-do compile } +-- { dg-options "-gnat12 -gnatct" } + +with Ada.Containers.Vectors; +with Limited_With4_Pkg; + +package Limited_With4 is + +   type Object is tagged private; +   type Object_Ref is access all Object; +   type Class_Ref is access all Object'Class; + +   package Vec is new Ada.Containers.Vectors +     (Positive, Limited_With4_Pkg.Object_Ref,Limited_With4_Pkg ."="); +   subtype Vector is Vec.Vector; + +private + +   type Object is tagged record +      V : Vector; +   end record; + +end Limited_With4; diff --git a/gcc/testsuite/gnat.dg/specs/limited_with4_pkg.ads b/gcc/testsuite/gnat.dg/specs/limited_with4_pkg.ads new file mode 100644 index 0000000..f69ab47 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/limited_with4_pkg.ads @@ -0,0 +1,15 @@ +-- { dg-do compile } +-- { dg-options "-gnat12 -gnatct" } + +limited with Limited_With4; + +package Limited_With4_Pkg is + +   type Object is tagged null record; +   type Object_Ref is access all Object; +   type Class_Ref is access all Object'Class; + +   function Func return Limited_With4.Class_Ref; +   procedure Proc (Arg : Limited_With4.Class_Ref); + +end Limited_With4_Pkg; | 
