This patch is the first step for implementation of aliased parameters in Ada 2012 mode. It recognizes the keyword aliased on parameters and ensures that they are passed by reference. The following program prints out the value 5.
1. pragma Ada_2012; 2. with Text_IO; use Text_IO; 3. procedure AliasP1 is 4. G : Integer; 5. 6. procedure K (R : aliased in out Integer) is 7. begin 8. G := 2; 9. R := 5; 10. Put_Line (G'Img); 11. end; 12. begin 13. K (G); 14. end; This is only the first step, We have not dealt with access checking etc yet that is required. Tested on x86_64-pc-linux-gnu, committed on trunk 2011-09-01 Robert Dewar <de...@adacore.com> * einfo.ads (Is_Aliased): Fix existing documentation and add note on possibility of this flag being set for formals in Ada 2012 mode. * par-ch6.adb (P_Formal_Part): Handle aliased for parameters for Ada 2012. * sem_ch6.adb (Process_Formals): Handle aliased parameters in Ada 2012 mode. * sinfo.adb (Aliased_Present): Allowed in N_Parameter_Specification for Ada 2012. * sinfo.ads (Aliased_Present): Allowed in N_Parameter_Specification for Ada 2012.
Index: sinfo.adb =================================================================== --- sinfo.adb (revision 178381) +++ sinfo.adb (working copy) @@ -206,7 +206,8 @@ begin pragma Assert (False or else NT (N).Nkind = N_Component_Definition - or else NT (N).Nkind = N_Object_Declaration); + or else NT (N).Nkind = N_Object_Declaration + or else NT (N).Nkind = N_Parameter_Specification); return Flag4 (N); end Aliased_Present; @@ -3265,7 +3266,8 @@ begin pragma Assert (False or else NT (N).Nkind = N_Component_Definition - or else NT (N).Nkind = N_Object_Declaration); + or else NT (N).Nkind = N_Object_Declaration + or else NT (N).Nkind = N_Parameter_Specification); Set_Flag4 (N, Val); end Set_Aliased_Present; Index: sinfo.ads =================================================================== --- sinfo.ads (revision 178381) +++ sinfo.ads (working copy) @@ -2322,7 +2322,7 @@ -- N_Object_Declaration -- Sloc points to first identifier -- Defining_Identifier (Node1) - -- Aliased_Present (Flag4) set if ALIASED appears + -- Aliased_Present (Flag4) -- Constant_Present (Flag17) set if CONSTANT appears -- Null_Exclusion_Present (Flag11) -- Object_Definition (Node4) subtype indic./array type def./access def. @@ -4514,8 +4514,8 @@ ---------------------------------- -- PARAMETER_SPECIFICATION ::= - -- DEFINING_IDENTIFIER_LIST : MODE [NULL_EXCLUSION] SUBTYPE_MARK - -- [:= DEFAULT_EXPRESSION] + -- DEFINING_IDENTIFIER_LIST : [ALIASED] MODE [NULL_EXCLUSION] + -- SUBTYPE_MARK [:= DEFAULT_EXPRESSION] -- | DEFINING_IDENTIFIER_LIST : ACCESS_DEFINITION -- [:= DEFAULT_EXPRESSION] @@ -4527,9 +4527,12 @@ -- Prev_Ids flags to preserve the original source form as described -- in the section on "Handling of Defining Identifier Lists". + -- ALIASED can only be present in Ada 2012 mode + -- N_Parameter_Specification -- Sloc points to first identifier -- Defining_Identifier (Node1) + -- Aliased_Present (Flag4) -- In_Present (Flag15) -- Out_Present (Flag17) -- Null_Exclusion_Present (Flag11) Index: einfo.ads =================================================================== --- einfo.ads (revision 178381) +++ einfo.ads (working copy) @@ -1997,8 +1997,9 @@ -- of pragma Ada_12 or Ada_2012. -- Is_Aliased (Flag15) --- Present in objects whose declarations carry the keyword aliased, --- and on record components that have the keyword. +-- Present in all entities. Set for objects and types whose declarations +-- carry the keyword aliased, and on record components that have the +-- keyword. For Ada 2012, also applies to formal parameters. -- Is_AST_Entry (Flag132) -- Present in entry entities. Set if a valid pragma AST_Entry applies @@ -4773,6 +4774,7 @@ -- Is_Ada_2005_Only (Flag185) -- Is_Ada_2012_Only (Flag199) -- Is_Bit_Packed_Array (Flag122) (base type only) + -- Is_Aliased (Flag15) -- Is_Character_Type (Flag63) -- Is_Child_Unit (Flag73) -- Is_Compilation_Unit (Flag149) @@ -4994,7 +4996,6 @@ -- Component_Alignment (special) (base type only) -- Has_Component_Size_Clause (Flag68) (base type only) -- Has_Pragma_Pack (Flag121) (impl base type only) - -- Is_Aliased (Flag15) -- Is_Constrained (Flag12) -- Next_Index (synth) -- Number_Dimensions (synth) Index: par-ch6.adb =================================================================== --- par-ch6.adb (revision 178381) +++ par-ch6.adb (working copy) @@ -1186,8 +1186,8 @@ -- FORMAL_PART ::= (PARAMETER_SPECIFICATION {; PARAMETER_SPECIFICATION}) -- PARAMETER_SPECIFICATION ::= - -- DEFINING_IDENTIFIER_LIST : MODE [NULL_EXCLUSION] SUBTYPE_MARK - -- [:= DEFAULT_EXPRESSION] + -- DEFINING_IDENTIFIER_LIST : [ALIASED] MODE [NULL_EXCLUSION] + -- SUBTYPE_MARK [:= DEFAULT_EXPRESSION] -- | DEFINING_IDENTIFIER_LIST : ACCESS_DEFINITION -- [:= DEFAULT_EXPRESSION] @@ -1195,6 +1195,8 @@ -- that the initial token is a left parenthesis, and skipped past it, so -- that on entry Token is the first token following the left parenthesis. + -- Note: The ALIASED keyword is allowed only in Ada 2012 mode (AI 142) + -- Error recovery: cannot raise Error_Resync function P_Formal_Part return List_Id is @@ -1235,9 +1237,11 @@ if Token /= Tok_Comma then - -- Assume colon if IN or OUT keyword found + -- Assume colon if ALIASED, IN or OUT keyword found - exit Ident_Loop when Token = Tok_In or else Token = Tok_Out; + exit Ident_Loop when Token = Tok_Aliased or else + Token = Tok_In or else + Token = Tok_Out; -- Otherwise scan ahead @@ -1303,6 +1307,18 @@ New_Node (N_Parameter_Specification, Ident_Sloc); Set_Defining_Identifier (Specification_Node, Idents (Ident)); + -- Scan possible ALIASED for Ada 2012 (AI-142) + + if Token = Tok_Aliased then + if Ada_Version < Ada_2012 then + Error_Msg_SC ("ALIASED parameter is an Ada2012 feature"); + else + Set_Aliased_Present (Specification_Node); + end if; + + Scan; -- past ALIASED + end if; + -- Scan possible NOT NULL for Ada 2005 (AI-231, AI-447) Not_Null_Sloc := Token_Ptr; Index: sem_ch6.adb =================================================================== --- sem_ch6.adb (revision 178381) +++ sem_ch6.adb (working copy) @@ -8900,7 +8900,6 @@ elsif not Nkind_In (Parent (T), N_Access_Function_Definition, N_Access_Procedure_Definition) then - -- AI05-0151: Tagged incomplete types are allowed in all -- formal parts. Untagged incomplete types are not allowed -- in bodies. @@ -8935,6 +8934,14 @@ Parameter_Type (Param_Spec), Formal_Type); end if; + -- Ada 2012 (AI-142): Handle aliased parameters + + if Ada_Version >= Ada_2012 + and then Aliased_Present (Param_Spec) + then + Set_Is_Aliased (Formal); + end if; + -- Ada 2005 (AI-231): Create and decorate an internal subtype -- declaration corresponding to the null-excluding type of the -- formal in the enclosing scope. Finally, replace the parameter @@ -9005,6 +9012,8 @@ Set_Etype (Formal, Formal_Type); + -- Deal with default expression if present + Default := Expression (Param_Spec); if Present (Default) then @@ -9118,6 +9127,12 @@ Num_Out_Params := Num_Out_Params + 1; end if; + -- Force call by reference if aliased + + if Is_Aliased (Formal) then + Set_Mechanism (Formal, By_Reference); + end if; + Next (Param_Spec); end loop; @@ -9579,8 +9594,7 @@ if Ekind (Designator) /= E_Procedure then declare Rent : constant Entity_Id := - Make_Defining_Identifier (Loc, - Chars => Name_uResult); + Make_Defining_Identifier (Loc, Name_uResult); Ftyp : constant Entity_Id := Etype (Designator); begin