diff options
Diffstat (limited to 'gcc/ada/sem_ch13.adb')
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 116 |
1 files changed, 49 insertions, 67 deletions
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index f7be890..31af1bb 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -442,11 +442,6 @@ package body Sem_Ch13 is Off : Boolean; -- Whether the address is offset within Y in the second case - - Alignment_Checks_Suppressed : Boolean; - -- Whether alignment checks are suppressed by an active scope suppress - -- setting. We need to save the value in order to be able to reuse it - -- after the back end has been run. end record; package Address_Clause_Checks is new Table.Table ( @@ -457,26 +452,6 @@ package body Sem_Ch13 is Table_Increment => 200, Table_Name => "Address_Clause_Checks"); - function Alignment_Checks_Suppressed - (ACCR : Address_Clause_Check_Record) return Boolean; - -- Return whether the alignment check generated for the address clause - -- is suppressed. - - --------------------------------- - -- Alignment_Checks_Suppressed -- - --------------------------------- - - function Alignment_Checks_Suppressed - (ACCR : Address_Clause_Check_Record) return Boolean - is - begin - if Checks_May_Be_Suppressed (ACCR.X) then - return Is_Check_Suppressed (ACCR.X, Alignment_Check); - else - return ACCR.Alignment_Checks_Suppressed; - end if; - end Alignment_Checks_Suppressed; - ----------------------------------------- -- Adjust_Record_For_Reverse_Bit_Order -- ----------------------------------------- @@ -5041,16 +5016,6 @@ package body Sem_Ch13 is Analyze_Aspect_Implicit_Dereference; goto Continue; - when Aspect_Constructor => - if not All_Extensions_Allowed then - Error_Msg_Name_1 := Nam; - Error_Msg_GNAT_Extension ("aspect %", Loc); - goto Continue; - end if; - - Set_Constructor_Name (E, Expr); - Set_Needs_Construction (E); - -- Dimension when Aspect_Dimension => @@ -7096,11 +7061,15 @@ package body Sem_Ch13 is end if; end; - -- Entity has delayed freeze, so we will generate an + -- The entity has delayed freeze, so we will generate an -- alignment check at the freeze point unless suppressed. + -- We will unconditionally generate it when the alignment + -- is specified in addition to the address, to compensate + -- for the check being suppressed by default on machines + -- that do not need strict alignment of memory accesses. - if not Range_Checks_Suppressed (U_Ent) - and then not Alignment_Checks_Suppressed (U_Ent) + if not Alignment_Checks_Suppressed (U_Ent) + or else Present (Alignment_Clause (U_Ent)) then Set_Check_Address_Alignment (N); end if; @@ -7175,6 +7144,14 @@ package body Sem_Ch13 is if Is_Array_Type (U_Ent) then Set_Alignment (Base_Type (U_Ent), Align); end if; + + -- See the Attribute_Address case above for the rationale + + if not Is_Type (U_Ent) + and then Present (Address_Clause (U_Ent)) + then + Set_Check_Address_Alignment (Address_Clause (U_Ent)); + end if; end if; end Alignment; @@ -7844,7 +7821,7 @@ package body Sem_Ch13 is end if; end if; - -- For Object'Size, set Esize only + -- For objects, set Esize only else if Is_Elementary_Type (Etyp) @@ -7858,26 +7835,37 @@ package body Sem_Ch13 is Error_Msg_Uint_2 := UI_From_Int (System_Max_Integer_Size); Error_Msg_N - ("size for primitive object must be a power of 2 in " - & "the range ^-^", N); - end if; + ("size for elementary object must be a power of 2 " + & "in the range ^-^", N); - Set_Esize (U_Ent, Size); - end if; + -- As per RM 13.1(25/5), only a confirming size clause + -- (i.e. Size = Type'Object_Size) for aliased objects + -- of elementary types is required to be supported. + -- We reject nonconfirming clauses for these objects. - -- As of RM 13.1, only confirming size - -- (i.e. (Size = Esize (Etyp))) for aliased object of - -- elementary type must be supported. - -- GNAT rejects nonconfirming size for such object. + elsif Is_Aliased (U_Ent) + and then Is_Elementary_Type (Etyp) + and then Size /= Esize (Etyp) + then + Error_Msg_N + ("nonconfirming Size for aliased object is not " + & "supported", N); - if Is_Aliased (U_Ent) - and then Is_Elementary_Type (Etyp) - and then Known_Esize (U_Ent) - and then Size /= Esize (Etyp) - then - Error_Msg_N - ("nonconfirming Size for aliased object is not " - & "supported", N); + -- We also reject nonconfirming clauses for (nonaliased) + -- objects of floating-point types because smaller sizes + -- would require integer operations to access the objects + -- and larger sizes would require integer operations to + -- manipulate the padding bits. + + elsif Is_Floating_Point_Type (Etyp) + and then Size /= Esize (Etyp) + then + Error_Msg_N + ("nonconfirming Size for floating-point object is " + & "not supported", N); + end if; + + Set_Esize (U_Ent, Size); end if; -- Handle extension aspect 'Size'Class which allows for @@ -11753,8 +11741,7 @@ package body Sem_Ch13 is -- name, so we need to verify that one of these interpretations is -- the one available at the freeze point. - elsif A_Id in Aspect_Constructor - | Aspect_Destructor + elsif A_Id in Aspect_Destructor | Aspect_Input | Aspect_Output | Aspect_Read @@ -12050,8 +12037,7 @@ package body Sem_Ch13 is -- Special case, the expression of these aspects is just an entity -- that does not need any resolution, so just analyze. - when Aspect_Constructor - | Aspect_Input + when Aspect_Input | Aspect_Output | Aspect_Put_Image | Aspect_Read @@ -16670,9 +16656,8 @@ package body Sem_Ch13 is Y : Entity_Id; Off : Boolean) is - ACS : constant Boolean := Scope_Suppress.Suppress (Alignment_Check); begin - Address_Clause_Checks.Append ((N, X, A, Y, Off, ACS)); + Address_Clause_Checks.Append ((N, X, A, Y, Off)); end Register_Address_Clause_Check; ------------------------ @@ -17357,9 +17342,6 @@ package body Sem_Ch13 is => null; - when Aspect_Constructor => - null; - when Aspect_Dynamic_Predicate | Aspect_Ghost_Predicate | Aspect_Predicate @@ -19125,7 +19107,7 @@ package body Sem_Ch13 is -- Check for known value not multiple of alignment if No (ACCR.Y) then - if not Alignment_Checks_Suppressed (ACCR) + if Check_Address_Alignment (ACCR.N) and then X_Alignment /= 0 and then ACCR.A mod X_Alignment /= 0 then @@ -19170,7 +19152,7 @@ package body Sem_Ch13 is -- Note: we do not check the alignment if we gave a size -- warning, since it would likely be redundant. - elsif not Alignment_Checks_Suppressed (ACCR) + elsif Check_Address_Alignment (ACCR.N) and then Y_Alignment /= Uint_0 and then (Y_Alignment < X_Alignment |