diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 9 | ||||
| -rw-r--r-- | gcc/ada/sem_ch12.adb | 13 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 81 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.ads | 9 |
4 files changed, 108 insertions, 4 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 83947b7..4830074 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2012-01-23 Vincent Pucci <pucci@adacore.com> + + * sem_ch12.adb (Analyze_Generic_Subprogram_Declaration): Call + to Make_Aspect_For_PPC_In_Gen_Sub_Decl added in ASIS mode. + * sem_prag.adb, sem_prag.ads (Make_Aspect_For_PPC_In_Gen_Sub_Decl): New + routine. In ASIS mode, convert any PPC pragmas into aspects in generic + subprogram declaration in order to enable the analysis of PPC boolean + expressions. + 2012-01-23 Robert Dewar <dewar@adacore.com> * sem_ch3.adb (Analyze_Object_Declaration): Properly diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 4976294..a954ccd 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -59,6 +59,7 @@ with Sem_Disp; use Sem_Disp; with Sem_Elab; use Sem_Elab; with Sem_Elim; use Sem_Elim; with Sem_Eval; use Sem_Eval; +with Sem_Prag; use Sem_Prag; with Sem_Res; use Sem_Res; with Sem_Type; use Sem_Type; with Sem_Util; use Sem_Util; @@ -3082,6 +3083,15 @@ package body Sem_Ch12 is end; end if; + -- For ASIS purposes, convert any postcondition, precondition pragmas + -- into aspects, if N is not a compilation unit by itself, in order to + -- enable the analysis of expressions inside the corresponding PPC + -- pragmas. + + if ASIS_Mode and then Is_List_Member (N) then + Make_Aspect_For_PPC_In_Gen_Sub_Decl (N); + end if; + Spec := Specification (N); Id := Defining_Entity (Spec); Generate_Definition (Id); @@ -4662,7 +4672,8 @@ package body Sem_Ch12 is end if; Generate_Definition (Act_Decl_Id); - Set_Contract (Anon_Id, Make_Contract (Sloc (Anon_Id))); -- ??? needed? + -- Set_Contract (Anon_Id, Make_Contract (Sloc (Anon_Id))); + -- ??? needed? Set_Contract (Act_Decl_Id, Make_Contract (Sloc (Act_Decl_Id))); -- Inherit all inlining-related flags which apply to the generic in diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 00b27d3..73d57a4 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -7991,8 +7991,9 @@ package body Sem_Prag is -- Normally the analysis that follows will freeze the subprogram -- being called. However, if the call is to a null procedure, -- we want to freeze it before creating the block, because the - -- analysis that follows may be done with expansion disabled, and - -- and the body will not be generated, leading to spurious errors. + -- analysis that follows may be done with expansion disabled, in + -- which case the body will not be generated, leading to spurious + -- errors. if Nkind (Call) = N_Procedure_Call_Statement and then Is_Entity_Name (Name (Call)) @@ -15242,6 +15243,82 @@ package body Sem_Prag is end if; end Is_Pragma_String_Literal; + ----------------------------------------- + -- Make_Aspect_For_PPC_In_Gen_Sub_Decl -- + ----------------------------------------- + + -- Convert any PPC and pragmas that appear within a generic subprogram + -- declaration into aspect. + + procedure Make_Aspect_For_PPC_In_Gen_Sub_Decl (Decl : Node_Id) is + Aspects : constant List_Id := New_List; + Loc : constant Source_Ptr := Sloc (Decl); + Or_Decl : constant Node_Id := Original_Node (Decl); + Aspect : Node_Id; + Original_Aspects : List_Id; + -- To capture global references, a copy of the created aspects must be + -- inserted in the original tree. + + Prag : Node_Id; + Prag_Arg_Ass : Node_Id; + Prag_Id : Pragma_Id; + + begin + Prag := Next (Decl); + + -- Check for any PPC pragmas that appear within Decl + + while Nkind (Prag) = N_Pragma loop + Prag_Id := Get_Pragma_Id (Chars (Pragma_Identifier (Prag))); + + case Prag_Id is + when Pragma_Postcondition | Pragma_Precondition => + Prag_Arg_Ass := First (Pragma_Argument_Associations (Prag)); + + -- Make an aspect from any PPC pragma + + Aspect := + Make_Aspect_Specification (Loc, + Identifier => + Make_Identifier (Loc, Chars (Pragma_Identifier (Prag))), + Expression => Expression (Prag_Arg_Ass)); + + Append (Aspect, Aspects); + + -- Set the pragma node analyzed to avoid any further analysis + + Set_Analyzed (Prag, True); + + when others => null; + end case; + + Next (Prag); + end loop; + + -- Set all new aspects into the generic declaration node + + if Is_Non_Empty_List (Aspects) then + -- Create the list of aspects which will be inserted in the original + -- tree. + + Original_Aspects := Copy_Separate_List (Aspects); + + -- Check if Decl already has aspects + -- Attach the new lists of aspects to both the generic copy and the + -- original tree. + + if Has_Aspects (Decl) then + Append_List (Aspects, Aspect_Specifications (Decl)); + Append_List (Original_Aspects, Aspect_Specifications (Or_Decl)); + else + Set_Parent (Aspects, Decl); + Set_Aspect_Specifications (Decl, Aspects); + Set_Parent (Original_Aspects, Or_Decl); + Set_Aspect_Specifications (Or_Decl, Original_Aspects); + end if; + end if; + end Make_Aspect_For_PPC_In_Gen_Sub_Decl; + ------------------------ -- Preanalyze_TC_Args -- ------------------------ diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads index 18ffcc3..503b658 100644 --- a/gcc/ada/sem_prag.ads +++ b/gcc/ada/sem_prag.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -110,6 +110,13 @@ package Sem_Prag is -- length, and then returns True. If it is not of the correct form, then an -- appropriate error message is posted, and False is returned. + procedure Make_Aspect_For_PPC_In_Gen_Sub_Decl (Decl : Node_Id); + -- This routine makes aspects from precondition or postcondition pragmas + -- that appear within a generic subprogram declaration. Decl is the generic + -- subprogram declaration node. + -- Note that the aspects are attached to the generic copy and also to the + -- orginal tree. + procedure Process_Compilation_Unit_Pragmas (N : Node_Id); -- Called at the start of processing compilation unit N to deal with any -- special issues regarding pragmas. In particular, we have to deal with |