diff options
Diffstat (limited to 'gcc/ada/sem_attr.adb')
| -rw-r--r-- | gcc/ada/sem_attr.adb | 54 |
1 files changed, 54 insertions, 0 deletions
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 4b599151f8e..30684916644 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -315,6 +315,9 @@ package body Sem_Attr is -- corresponding possible defined attribute function (e.g. for the -- Read attribute, Nam will be TSS_Stream_Read). + procedure Check_PolyORB_Attribute; + -- Validity checking for PolyORB/DSA attribute + procedure Check_Task_Prefix; -- Verify that prefix of attribute N is a task or task type @@ -1380,6 +1383,23 @@ package body Sem_Attr is end if; end Check_Object_Reference; + ---------------------------- + -- Check_PolyORB_Attribute -- + ---------------------------- + + procedure Check_PolyORB_Attribute is + begin + Validate_Non_Static_Attribute_Function_Call; + + Check_Type; + Check_Not_CPP_Type; + + if Get_PCS_Name /= Name_PolyORB_DSA then + Error_Attr + ("attribute% requires the 'Poly'O'R'B 'P'C'S", N); + end if; + end Check_PolyORB_Attribute; + ------------------------ -- Check_Program_Unit -- ------------------------ @@ -2976,6 +2996,15 @@ package body Sem_Attr is Set_Etype (N, P_Base_Type); Resolve (E1, P_Base_Type); + -------------- + -- From_Any -- + -------------- + + when Attribute_From_Any => + Check_E1; + Check_PolyORB_Attribute; + Set_Etype (N, P_Base_Type); + ----------------------- -- Has_Access_Values -- ----------------------- @@ -4238,6 +4267,15 @@ package body Sem_Attr is Analyze_And_Resolve (E1, Any_Integer); Set_Etype (N, RTE (RE_Address)); + ------------ + -- To_Any -- + ------------ + + when Attribute_To_Any => + Check_E1; + Check_PolyORB_Attribute; + Set_Etype (N, RTE (RE_Any)); + ---------------- -- Truncation -- ---------------- @@ -4257,6 +4295,15 @@ package body Sem_Attr is Check_Not_Incomplete_Type; Set_Etype (N, RTE (RE_Type_Class)); + ------------ + -- To_Any -- + ------------ + + when Attribute_TypeCode => + Check_E0; + Check_PolyORB_Attribute; + Set_Etype (N, RTE (RE_TypeCode)); + ----------------- -- UET_Address -- ----------------- @@ -7253,6 +7300,13 @@ package body Sem_Attr is end if; end Width; + -- The following attributes denote function that cannot be folded + + when Attribute_From_Any | + Attribute_To_Any | + Attribute_TypeCode => + null; + -- The following attributes can never be folded, and furthermore we -- should not even have entered the case statement for any of these. -- Note that in some cases, the values have already been folded as |