diff options
Diffstat (limited to 'gcc/ada/sem_attr.adb')
| -rw-r--r-- | gcc/ada/sem_attr.adb | 156 |
1 files changed, 53 insertions, 103 deletions
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index e9e245a..20270c2 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -3957,6 +3957,13 @@ package body Sem_Attr is Error_Attr_P ("prefix of % attribute must be object of discriminated type"); + ----------------- + -- Constructor -- + ----------------- + + when Attribute_Constructor => + Error_Attr_P ("attribute% can only be used to define constructors"); + --------------- -- Copy_Sign -- --------------- @@ -5180,12 +5187,17 @@ package body Sem_Attr is Expr : Entity_Id; begin if not All_Extensions_Allowed then - Error_Msg_GNAT_Extension ("Make attribute", Loc); + Error_Msg_GNAT_Extension ("attribute %", Loc); return; end if; + Check_Type; Set_Etype (N, Etype (P)); + if not Needs_Construction (Entity (P)) then + Error_Msg_NE ("no available constructor for&", N, Entity (P)); + end if; + if Present (Expressions (N)) then Expr := First (Expressions (N)); while Present (Expr) loop @@ -5197,6 +5209,9 @@ package body Sem_Attr is Next (Expr); end loop; + + elsif not Has_Default_Constructor (Entity (P)) then + Error_Msg_NE ("no default constructor for&", N, Entity (P)); end if; end; @@ -11144,6 +11159,7 @@ package body Sem_Attr is | Attribute_Class | Attribute_Code_Address | Attribute_Compiler_Version + | Attribute_Constructor | Attribute_Count | Attribute_Default_Bit_Order | Attribute_Default_Scalar_Storage_Order @@ -12477,70 +12493,6 @@ package body Sem_Attr is Set_Address_Taken (Entity (P)); end if; - if Nkind (P) = N_Slice then - - -- Arr (X .. Y)'address is identical to Arr (X)'address, - -- even if the array is packed and the slice itself is not - -- addressable. Transform the prefix into an indexed component. - - -- Note that the transformation is safe only if we know that - -- the slice is non-null. That is because a null slice can have - -- an out of bounds index value. - - -- Right now, gigi blows up if given 'Address on a slice as a - -- result of some incorrect freeze nodes generated by the front - -- end, and this covers up that bug in one case, but the bug is - -- likely still there in the cases not handled by this code ??? - - -- It's not clear what 'Address *should* return for a null - -- slice with out of bounds indexes, this might be worth an ARG - -- discussion ??? - - -- One approach would be to do a length check unconditionally, - -- and then do the transformation below unconditionally, but - -- analyze with checks off, avoiding the problem of the out of - -- bounds index. This approach would interpret the address of - -- an out of bounds null slice as being the address where the - -- array element would be if there was one, which is probably - -- as reasonable an interpretation as any ??? - - declare - Loc : constant Source_Ptr := Sloc (P); - D : constant Node_Id := Discrete_Range (P); - Lo : Node_Id; - - begin - if Is_Entity_Name (D) - and then - Not_Null_Range - (Type_Low_Bound (Entity (D)), - Type_High_Bound (Entity (D))) - then - Lo := - Make_Attribute_Reference (Loc, - Prefix => (New_Occurrence_Of (Entity (D), Loc)), - Attribute_Name => Name_First); - - elsif Nkind (D) = N_Range - and then Not_Null_Range (Low_Bound (D), High_Bound (D)) - then - Lo := Low_Bound (D); - - else - Lo := Empty; - end if; - - if Present (Lo) then - Rewrite (P, - Make_Indexed_Component (Loc, - Prefix => Relocate_Node (Prefix (P)), - Expressions => New_List (Lo))); - - Analyze_And_Resolve (P); - end if; - end; - end if; - ------------------ -- Body_Version -- ------------------ @@ -12805,45 +12757,43 @@ package body Sem_Attr is and then Scope (Op) = Standard_Standard and then not Strict then - declare - Op_Chars : constant Any_Operator_Name := Chars (Op); - -- Nonassociative ops like division are unlikely - -- to come up in practice, but they are legal. - begin - case Op_Chars is - when Name_Op_Add - | Name_Op_Subtract - | Name_Op_Multiply - | Name_Op_Divide - | Name_Op_Expon - => - return Is_Numeric_Type (Typ); - - when Name_Op_Mod | Name_Op_Rem => - return Is_Numeric_Type (Typ) - and then Is_Discrete_Type (Typ); - - when Name_Op_And | Name_Op_Or | Name_Op_Xor => - -- No Boolean array operators in Standard - return Is_Boolean_Type (Typ) - or else Is_Modular_Integer_Type (Typ); + -- Nonassociative ops like division are unlikely to + -- come up in practice, but they are legal. + + case Any_Operator_Name'(Chars (Op)) is + when Name_Op_Add + | Name_Op_Subtract + | Name_Op_Multiply + | Name_Op_Divide + | Name_Op_Expon + => + return Is_Numeric_Type (Typ); + + when Name_Op_Mod | Name_Op_Rem => + return Is_Numeric_Type (Typ) + and then Is_Discrete_Type (Typ); + + when Name_Op_And | Name_Op_Or | Name_Op_Xor => + -- No Boolean array operators in Standard + return Is_Boolean_Type (Typ) + or else Is_Modular_Integer_Type (Typ); + + when Name_Op_Concat => + return Is_Array_Type (Typ) + and then Number_Dimensions (Typ) = 1; + + when Name_Op_Eq | Name_Op_Ne + | Name_Op_Lt | Name_Op_Le + | Name_Op_Gt | Name_Op_Ge + => + return Is_Boolean_Type (Typ); + + when Name_Op_Abs | Name_Op_Not => + -- unary ops were already handled + + raise Program_Error; + end case; - when Name_Op_Concat => - return Is_Array_Type (Typ) - and then Number_Dimensions (Typ) = 1; - - when Name_Op_Eq | Name_Op_Ne - | Name_Op_Lt | Name_Op_Le - | Name_Op_Gt | Name_Op_Ge - => - return Is_Boolean_Type (Typ); - - when Name_Op_Abs | Name_Op_Not => - -- unary ops were already handled - pragma Assert (False); - raise Program_Error; - end case; - end; else return False; end if; |