diff options
Diffstat (limited to 'gcc/ada')
-rw-r--r-- | gcc/ada/ChangeLog | 378 | ||||
-rw-r--r-- | gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst | 32 | ||||
-rw-r--r-- | gcc/ada/exp_ch7.adb | 14 | ||||
-rw-r--r-- | gcc/ada/exp_util.adb | 16 | ||||
-rw-r--r-- | gcc/ada/freeze.adb | 83 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/Make-lang.in | 2 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/decl.cc | 27 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/trans.cc | 29 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/utils.cc | 4 | ||||
-rw-r--r-- | gcc/ada/gnat_rm.texi | 34 | ||||
-rw-r--r-- | gcc/ada/mutably_tagged.adb | 60 | ||||
-rw-r--r-- | gcc/ada/sem_aux.ads | 2 | ||||
-rw-r--r-- | gcc/ada/sem_ch13.adb | 58 | ||||
-rw-r--r-- | gcc/ada/sem_ch8.adb | 34 | ||||
-rw-r--r-- | gcc/ada/sem_res.adb | 20 |
15 files changed, 712 insertions, 81 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8aaa006..d88e73f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,381 @@ +2025-07-04 Eric Botcazou <ebotcazou@adacore.com> + + * gcc-interface/Make-lang.in (ACATSDIR): Change to acats-4. + +2025-07-04 Eric Botcazou <ebotcazou@adacore.com> + + * gcc-interface/utils.cc (make_packable_type): Clear the TYPE_PACKED + flag in the case where the alignment is bumped. + +2025-07-04 Eric Botcazou <ebotcazou@adacore.com> + + * gcc-interface/trans.cc (Subprogram_Body_to_gnu): Do not generate + a block-copy out for a null initialization procedure when the _Init + parameter is not passed in. + +2025-07-04 Eric Botcazou <ebotcazou@adacore.com> + + * gcc-interface/decl.cc (gnat_to_gnu_subprog_type): Only apply the + transformation to integer types. + +2025-07-04 Eric Botcazou <ebotcazou@adacore.com> + + * gcc-interface/decl.cc (gnat_to_gnu_subprog_type): Add guards. + +2025-07-04 Eric Botcazou <ebotcazou@adacore.com> + + * gcc-interface/decl.cc (gnat_to_gnu_subprog_type): In the case of a + subprogram using the Copy-In/Copy-Out mechanism, deal specially with + the case of 2 parameters of differing sizes. + * gcc-interface/trans.cc (Subprogram_Body_to_gnu): In the case of a + subprogram using the Copy-In/Copy-Out mechanism, make sure the types + are consistent on the two sides for all the parameters. + +2025-07-04 Steve Baird <baird@adacore.com> + + * sem_res.adb (Resolve_Type_Conversion): Replace code for + detecting a similar case with a more comprehensive test. + +2025-07-04 Bob Duff <duff@adacore.com> + + * doc/gnat_rm/implementation_defined_pragmas.rst + (Short_Circuit_And_Or): Add more documentation. + * sem_ch8.adb (Analyze_Subprogram_Renaming): + Disallow renamings. + * gnat_rm.texi: Regenerate. + +2025-07-04 Ronan Desplanques <desplanques@adacore.com> + + * exp_ch7.adb (Make_Final_Call): Tweak search of Finalize primitive. + * exp_util.adb (Finalize_Address): Likewise. + +2025-07-04 Eric Botcazou <ebotcazou@adacore.com> + + * freeze.adb (Check_Compile_Time_Size): Try harder to see whether + the bounds of array types are known at compile time. + +2025-07-04 Piotr Trojanek <trojanek@adacore.com> + + * sem_aux.ads (First_Discriminant): Remove space before period. + +2025-07-04 Steve Baird <baird@adacore.com> + + * sem_ch13.adb (Analyze_Record_Representation_Clause): In deciding + whether to generate a warning about a missing component clause, in + addition to calling Is_Unchecked_Union also call a new local + function, Unchecked_Union_Pragma_Pending, which checks for the + case of a not-yet-analyzed Unchecked_Union pragma occurring later + in the declaration list. + +2025-07-04 Steve Baird <baird@adacore.com> + + * mutably_tagged.adb (Make_CW_Size_Compile_Check): Include the + value of the Size'Class limit in the message generated via a + Compile_Time_Error pragma. + +2025-07-04 Ronan Desplanques <desplanques@adacore.com> + + * sem_ch13.adb (Check_Aspect_At_Freeze_Point): Remove obsolete bits. + +2025-07-04 Ronan Desplanques <desplanques@adacore.com> + + * sem_ch13.adb (Analyze_Aspect_Specifications): Fix error emission. + +2025-07-03 Eric Botcazou <ebotcazou@adacore.com> + + * gcc-interface/Makefile.in (gnatlib-sjlj): Delete. + (gnatlib-zcx): Do not modify Frontend_Exceptions constant. + * libgnat/system-linux-loongarch.ads (Frontend_Exceptions): Delete. + +2025-07-03 Eric Botcazou <ebotcazou@adacore.com> + + * gcc-interface/decl.cc (type_contains_only_integral_data): Do not + return false only because the type contains pointer data. + +2025-07-03 Eric Botcazou <ebotcazou@adacore.com> + + * gcc-interface/decl.cc (gnat_to_gnu_entity): Use default messages + for errors reported for Object_Size clauses. + (validate_size): Give an error for stand-alone objects of composite + types if the specified size is not a multiple of the alignment. + +2025-07-03 Eric Botcazou <ebotcazou@adacore.com> + + * gcc-interface/trans.cc (addressable_p): Add COMPG third parameter. + <COMPONENT_REF>: Do not return true out of alignment considerations + for non-strict-alignment targets if COMPG is set. + (Call_to_gnu): Pass true as COMPG in the call to the addressable_p + predicate if the called subprogram is an initialization procedure. + +2025-07-03 Eric Botcazou <ebotcazou@adacore.com> + + * gcc-interface/trans.cc (gnat_to_gnu) <N_Allocator>: Allocate the + bounds alongside the data if the Is_Constr_Array_Subt_With_Bounds + flag is set on the designated type. + <N_Free_Statement>: Take into account the allocated bounds if the + Is_Constr_Array_Subt_With_Bounds flag is set on the designated type. + +2025-07-03 Eric Botcazou <ebotcazou@adacore.com> + + * gcc-interface/decl.cc (gnat_to_gnu_component_type): Validate the + Component_Size like the size of a type only if the component type + is actually packed. + +2025-07-03 Piotr Trojanek <trojanek@adacore.com> + + * sem_elab.adb (Check_Overriding_Primitive): Find early call region + of the subprogram body declaration, not of the subprogram body stub. + +2025-07-03 Bob Duff <duff@adacore.com> + + * gen_il-gen-gen_nodes.adb (N_Unchecked_Type_Conversion): + Remove useless Nmake_Assert. + * tbuild.adb (Unchecked_Convert_To): + Narrow the bitfield-related conditions. + +2025-07-03 Ronan Desplanques <desplanques@adacore.com> + + * exp_util.adb (Insert_Actions): Fix check. + +2025-07-03 Ronan Desplanques <desplanques@adacore.com> + + * exp_ch6.adb (Expand_Ctrl_Function_Call): Precisify comment. + +2025-07-03 Eric Botcazou <ebotcazou@adacore.com> + + * exp_ch6.adb (Expand_Ctrl_Function_Call): Do not bail out for the + declarations of return objects. + +2025-07-03 Daniel King <dmking@adacore.com> + + * Makefile.rtl (LIBGNAT_TARGET_PAIRS): New unit s-tsgsba__cheri.adb for morello-freebsd. + * libgnarl/s-tassta.adb (Get_Stack_Base): New function. + * libgnarl/s-tsgsba__cheri.adb: New file for CHERI targets. + * libgnarl/s-tsgsba.adb: New default file for non-CHERI targets. + * libgnat/s-stausa.adb (Fill_Stack, Compute_Result): Port to CHERI. + * libgnat/s-stausa.ads (Initialize_Analyzer, Stack_Analyzer): Port to CHERI. + +2025-07-03 Piotr Trojanek <trojanek@adacore.com> + + * sem_ch3.adb (Check_Return_Subtype_Indication): Use Original_Node. + +2025-07-03 Piotr Trojanek <trojanek@adacore.com> + + * sem_ch3.adb (Check_Return_Subtype_Indication): Use type from + explicit subtype indication, when possible. + +2025-07-03 Piotr Trojanek <trojanek@adacore.com> + + * sem_ch3.adb (Check_Return_Subtype_Indication): Adjust error message + to match the RM wording. + +2025-07-03 Piotr Trojanek <trojanek@adacore.com> + + * sem_ch3.adb (Check_Return_Subtype_Indication): Use the nominal + subtype of a return object; literally implement the RM rule about + elementary types; check for static subtype compatibility both when + the subtype is given as a subtype mark and a subtype indication. + +2025-07-03 Eric Botcazou <ebotcazou@adacore.com> + + * repinfo.adb (First_Comp_Or_Discr.Is_Placed_Before): Return True + only if the components are in the same component list. + +2025-07-03 Denis Mazzucato <mazzucato@adacore.com> + + * sem_disp.adb (Check_Dispatching_call): Fix uninitialized Subp_Entity. + * sem_util.adb (Update_Controlling_Argument): No need to replace controlling argument + in case of functions. + +2025-07-03 Eric Botcazou <ebotcazou@adacore.com> + + * errid.ads: Adjust header to renaming and fix copyright line. + * errid.adb: Adjust header to renaming and add blank line. + * erroutc-pretty_emitter.ads: Adjust header to renaming. + * erroutc-pretty_emitter.adb: Likewise. + * erroutc-sarif_emitter.ads: Likewise. + * erroutc-sarif_emitter.adb: Likewise. + * errsw.ads: Adjust header to renaming and add blank line. + * errsw.adb: Likewise. + * json_utils.ads: Likewise. + * json_utils.adb: Adjust header to renaming. + +2025-07-03 Piotr Trojanek <trojanek@adacore.com> + + * errid.ads (Diagnostic_Entries): Now a constant. + +2025-07-03 Piotr Trojanek <trojanek@adacore.com> + + * errid.ads (Diagnostic_Entries): Remove nested aggregate. + * errsw.adb (Switches): Likewise. + +2025-07-03 Ronan Desplanques <desplanques@adacore.com> + + * exp_ch7.adb (Make_Deep_Record_Body): Fix case of absent Initialize + primitive. + +2025-07-03 Piotr Trojanek <trojanek@adacore.com> + + * exp_ch3.adb (Count_Default_Sized_Task_Stacks): Refine subtypes of + parameters; same for callsites. + +2025-07-03 Eric Botcazou <ebotcazou@adacore.com> + + * exp_imgv.adb (Expand_Value_Attribute): Do not call Set_Etype on N + after rewriting it by means of OK_Convert_To. + +2025-07-03 Ronan Desplanques <desplanques@adacore.com> + + * exp_aggr.adb (Generate_Finalization_Actions): Stop assuming that + initialize primitive exists. + +2025-07-03 Ronan Desplanques <desplanques@adacore.com> + + * exp_ch7.adb (Build_Record_Deep_Procs): Fix typo in comment. + +2025-07-03 Gary Dismukes <dismukes@adacore.com> + + * sem_ch12.adb (Install_Spec): Remove "not Is_Generic_Instance (Par)" + in test for setting Instance_Parent_Unit. Revise comment to no longer + say "noninstance", plus remove "???". + (Remove_Parent): Restructure if_statement to allow for both "elsif" + parts to be executed (by changing them to be separate if_statements + within an "else" part). + +2025-07-03 Ronan Desplanques <desplanques@adacore.com> + + * exp_ch3.adb (Predefined_Primitive_Bodies): Fix comment. + +2025-07-03 Piotr Trojanek <trojanek@adacore.com> + + * exp_tss.adb (TSS): Refactor IF condition to make code smaller. + * lib.adb (Increment_Serial_Number, Synchronize_Serial_Number): + Use type of renamed object when creating renaming. + * lib.ads (Unit_Record): Refine subtype of dependency number. + +2025-07-03 Eric Botcazou <ebotcazou@adacore.com> + + * libgnat/s-valuef.adb: Document the prerequisites more precisely. + * libgnat/a-tifiio.adb (OK_Get_32): Adjust to the prerequisites. + (OK_Get_64): Likewise. + * libgnat/a-tifiio__128.adb (OK_Get_32): Likewise. + (OK_Get_64): Likewise. + (OK_Get_128): Likewise. + * libgnat/a-wtfiio.adb (OK_Get_32): Likewise. + (OK_Get_64): Likewise. + * libgnat/a-wtfiio__128.adb (OK_Get_32): Likewise. + (OK_Get_64): Likewise. + (OK_Get_128): Likewise. + * libgnat/a-ztfiio.adb (OK_Get_32): Likewise. + (OK_Get_64): Likewise. + * libgnat/a-ztfiio__128.adb (OK_Get_32): Likewise. + (OK_Get_64): Likewise. + (OK_Get_128): Likewise. + * exp_imgv.adb (Expand_Value_Attribute): Adjust the conditions under + which the RE_Value_Fixed{32,64,128} routines are called for ordinary + fixed-point types. + +2025-07-03 Ronan Desplanques <desplanques@adacore.com> + + * exp_ch3.adb (Make_Predefined_Primitive_Specs): Fix comment. + +2025-07-03 Ronan Desplanques <desplanques@adacore.com> + + * exp_ch7.adb (Insert_Actions_In_Scope_Around): Fix condition. + +2025-07-03 Bob Duff <duff@adacore.com> + + * checks.adb: Remove unnecessary "return;" statements. + * eval_fat.adb: Likewise. + * exp_aggr.adb: Likewise. + * exp_attr.adb: Likewise. + * exp_ch3.adb: Likewise. + * exp_ch4.adb: Likewise. + * exp_ch5.adb: Likewise. + * exp_ch6.adb: Likewise. + * exp_unst.adb: Likewise. + * krunch.adb: Likewise. + * layout.adb: Likewise. + * libgnat/s-excdeb.adb: Likewise. + * libgnat/s-trasym__dwarf.adb: Likewise. + * par-endh.adb: Likewise. + * par-tchk.adb: Likewise. + * sem.adb: Likewise. + * sem_attr.adb: Likewise. + * sem_ch6.adb: Likewise. + * sem_elim.adb: Likewise. + * sem_eval.adb: Likewise. + * sfn_scan.adb: Likewise. + +2025-07-03 Bob Duff <duff@adacore.com> + + * doc/gnat_rm/implementation_defined_characteristics.rst: + Change Ignore to Disable. + * sem_ch13.ads (Analyze_Aspect_Specifications): + Minor: Remove incorrect comment; there is no need to check + Has_Aspects (N) at the call site. + * gnat_rm.texi: Regenerate. + * gnat_ugn.texi: Regenerate. + +2025-07-03 Bob Duff <duff@adacore.com> + + * types.ads (Empty_Or_Error): Remove. + * atree.adb: Remove reference to Empty_Or_Error. + * par-endh.adb: Likewise. + * sem_ch12.adb: Likewise. + * sem_ch3.adb: Likewise. + * sem_util.adb: Likewise. + * treepr.adb: Likewise. + +2025-07-03 Viljar Indus <indus@adacore.com> + + * sem_ch10.adb(Analyze_With_Clause): Call Semantics instead + of Analyze to bring Current_Sem_Unit up to date. + +2025-07-03 Piotr Trojanek <trojanek@adacore.com> + + * lib-xref-spark_specific.adb + (Enclosing_Subprogram_Or_Library_Package): Traverse subunits and body + stubs. + +2025-07-03 Tonu Naks <naks@adacore.com> + + * libgnat/i-cstrin.ads (Value): add documentation + +2025-07-03 Aleksandra Pasek <pasek@adacore.com> + + * libgnat/a-strsup.adb (Super_Delete): Fix index check. + * libgnat/a-stwisu.adb (Super_Delete): Likewise. + * libgnat/a-stzsup.adb (Super_Delete): Likewise. + +2025-07-03 Eric Botcazou <ebotcazou@adacore.com> + + * exp_ch4.adb (Handle_Changed_Representation): Alphabetize local + variables. Set the No_Finalize_Actions flag on the assignment. + +2025-07-03 Joffrey Huguet <huguet@adacore.com> + + * aspects.ads: Define an identifier for Potentially_Invalid. + * doc/gnat_rm/implementation_defined_aspects.rst: Add section for Potentially_Invalid. + * sem_attr.adb (Analyze_Attribute_Old_Result): Attribute Old is allowed to occur in a + Potentially_Invalid aspect. + * sem_ch13.adb (Analyze_Aspect_Specifications): Handle Potentially_Invalid. + * sem_util.adb (Has_Potentially_Invalid): Returns True iff an entity is subject to the + Potentially_Invalid aspect. + * sem_util.ads (Has_Potentially_Invalid): Idem. + * snames.ads-tmpl: New name for Potentially_Invalid. + * gnat_rm.texi: Regenerate. + +2025-07-03 Piotr Trojanek <trojanek@adacore.com> + + * sem_ch10.adb (Analyze_Compilation_Unit): Ignored ghost unit need no + elaboration checks. + +2025-07-03 Eric Botcazou <ebotcazou@adacore.com> + + * libgnat/s-valued.adb (Integer_to_Decimal): Use truncation for the + scaled divide operation performed for bases other than 10. + 2025-07-01 Eric Botcazou <ebotcazou@adacore.com> PR ada/120705 diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst index 02013f1..3986298 100644 --- a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst +++ b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst @@ -5914,13 +5914,33 @@ Syntax: pragma Short_Circuit_And_Or; -This configuration pragma causes any occurrence of the AND operator applied to -operands of type Standard.Boolean to be short-circuited (i.e. the AND operator -is treated as if it were AND THEN). Or is similarly treated as OR ELSE. This -may be useful in the context of certification protocols requiring the use of -short-circuited logical operators. If this configuration pragma occurs locally -within the file being compiled, it applies only to the file being compiled. +This configuration pragma causes the predefined AND and OR operators of +type Standard.Boolean to have short-circuit semantics. That is, they +behave like AND THEN and OR ELSE; the right-hand side is not evaluated +if the left-hand side determines the result. This may be useful in the +context of certification protocols requiring the use of short-circuited +logical operators. + There is no requirement that all units in a partition use this option. +However, mixing of short-circuit and non-short-circuit semantics can be +confusing. Therefore, the recommended use is to put the pragma in a +configuration file that applies to the whole program. Alternatively, if +you have a legacy library that should not use this pragma, you can put +it in a separate library project that does not use the pragma. +In any case, fine-grained mixing of the different semantics is not +recommended. If pragma ``Short_Circuit_And_Or`` is specified, then it +is illegal to rename the predefined Boolean AND and OR, or to pass +them to generic formal functions; this corresponds to the fact that +AND THEN and OR ELSE cannot be renamed nor passed as generic formal +functions. + +Note that this pragma has no effect on other logical operators -- +predefined operators of modular types, array-of-boolean types and types +derived from Standard.Boolean, nor user-defined operators. + +See also the pragma ``Unevaluated_Use_Of_Old`` and the restriction +``No_Direct_Boolean_Operators``, which may be useful in conjunction +with ``Short_Circuit_And_Or``. Pragma Short_Descriptors ======================== diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index e4daf4b..009bee4 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -7906,12 +7906,16 @@ package body Exp_Ch7 is if Is_Untagged_Derivation (Typ) then if Is_Protected_Type (Typ) then Utyp := Corresponding_Record_Type (Root_Type (Base_Type (Typ))); - else - Utyp := Underlying_Type (Root_Type (Base_Type (Typ))); - if Is_Protected_Type (Utyp) then - Utyp := Corresponding_Record_Type (Utyp); - end if; + else + declare + Root : constant Entity_Id := + Underlying_Type (Root_Type (Base_Type (Typ))); + begin + if Is_Protected_Type (Root) then + Utyp := Corresponding_Record_Type (Root); + end if; + end; end if; Ref := Unchecked_Convert_To (Utyp, Ref); diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 4f98779..2172ce7 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -6190,11 +6190,17 @@ package body Exp_Util is Utyp := Corresponding_Record_Type (Root_Type (Btyp)); else - Utyp := Underlying_Type (Root_Type (Btyp)); - - if Is_Protected_Type (Utyp) then - Utyp := Corresponding_Record_Type (Utyp); - end if; + declare + Root : constant Entity_Id := Underlying_Type (Root_Type (Btyp)); + begin + if Is_Protected_Type (Root) then + Utyp := Corresponding_Record_Type (Root); + else + while No (TSS (Utyp, TSS_Finalize_Address)) loop + Utyp := Underlying_Type (Base_Type (Etype (Utyp))); + end loop; + end if; + end; end if; end if; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index be2115a..3755d9e 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -765,6 +765,9 @@ package body Freeze is -- in fact constrained by non-static discriminant values. Could be made -- more precise ??? + function Value_Known (Exp : Node_Id) return Boolean; + -- Return True if the value of expression Exp is known at compile time + -------------------- -- Set_Small_Size -- -------------------- @@ -880,13 +883,13 @@ package body Freeze is High := Type_High_Bound (Etype (Index)); end if; - if not Compile_Time_Known_Value (Low) - or else not Compile_Time_Known_Value (High) - or else Etype (Index) = Any_Type - then + if Etype (Index) = Any_Type then return False; - else + elsif Compile_Time_Known_Value (Low) + and then Compile_Time_Known_Value (High) + then + Dim := Expr_Value (High) - Expr_Value (Low) + 1; if Dim > Uint_0 then @@ -894,6 +897,12 @@ package body Freeze is else Size := Uint_0; end if; + + elsif Value_Known (Low) and then Value_Known (High) then + Size := Uint_0; + + else + return False; end if; Next_Index (Index); @@ -1160,6 +1169,70 @@ package body Freeze is return True; end Static_Discriminated_Components; + ----------------- + -- Value_Known -- + ----------------- + + function Value_Known (Exp : Node_Id) return Boolean is + begin + -- This is the immediate case + + if Compile_Time_Known_Value (Exp) then + return True; + end if; + + -- The value may be known only to the back end, the typical example + -- being the alignment or the various sizes of composite types; in + -- the latter case, we may mutually recurse with Size_Known. + + case Nkind (Exp) is + when N_Attribute_Reference => + declare + P : constant Node_Id := Prefix (Exp); + + begin + if not Is_Entity_Name (P) + or else not Is_Type (Entity (P)) + then + return False; + end if; + + case Get_Attribute_Id (Attribute_Name (Exp)) is + when Attribute_Alignment => + return True; + + when Attribute_Component_Size => + return Size_Known (Component_Type (Entity (P))); + + when Attribute_Object_Size + | Attribute_Size + | Attribute_Value_Size + => + return Size_Known (Entity (P)); + + when others => + return False; + end case; + end; + + when N_Binary_Op => + return Value_Known (Left_Opnd (Exp)) + and then Value_Known (Right_Opnd (Exp)); + + when N_Qualified_Expression + | N_Type_Conversion + | N_Unchecked_Type_Conversion + => + return Value_Known (Expression (Exp)); + + when N_Unary_Op => + return Value_Known (Right_Opnd (Exp)); + + when others => + return False; + end case; + end Value_Known; + -- Start of processing for Check_Compile_Time_Size begin diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index 1c93816..bbbd697 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/gcc/ada/gcc-interface/Make-lang.in @@ -1096,7 +1096,7 @@ check-ada-subtargets: check-acats-subtargets check-gnat-subtargets # No ada-specific selftests selftest-ada: -ACATSDIR = $(TESTSUITEDIR)/ada/acats-2 +ACATSDIR = $(TESTSUITEDIR)/ada/acats-4 ACATSCMD = run_acats.sh check_acats_numbers0:=1 2 3 4 5 6 7 8 9 diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc index 903ec84..86cbf5b 100644 --- a/gcc/ada/gcc-interface/decl.cc +++ b/gcc/ada/gcc-interface/decl.cc @@ -6421,6 +6421,33 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, since structures are incomplete for the back-end. */ else if (Convention (gnat_subprog) != Convention_Stubbed) { + /* If we have two entries that may be returned in integer registers, + the larger has power-of-2 size and the smaller is integer, then + extend the smaller to this power-of-2 size to get a return type + with power-of-2 size and no holes, again to speed up accesses. */ + if (list_length (gnu_cico_field_list) == 2 + && gnu_cico_only_integral_type) + { + tree typ1 = TREE_TYPE (gnu_cico_field_list); + tree typ2 = TREE_TYPE (DECL_CHAIN (gnu_cico_field_list)); + if (TREE_CODE (typ1) == INTEGER_TYPE + && integer_pow2p (TYPE_SIZE (typ2)) + && compare_tree_int (TYPE_SIZE (typ2), + MAX_FIXED_MODE_SIZE) <= 0 + && tree_int_cst_lt (TYPE_SIZE (typ1), TYPE_SIZE (typ2))) + TREE_TYPE (gnu_cico_field_list) + = gnat_type_for_size (TREE_INT_CST_LOW (TYPE_SIZE (typ2)), + TYPE_UNSIGNED (typ1)); + else if (TREE_CODE (typ2) == INTEGER_TYPE + && integer_pow2p (TYPE_SIZE (typ1)) + && compare_tree_int (TYPE_SIZE (typ1), + MAX_FIXED_MODE_SIZE) <= 0 + && tree_int_cst_lt (TYPE_SIZE (typ2), TYPE_SIZE (typ1))) + TREE_TYPE (DECL_CHAIN (gnu_cico_field_list)) + = gnat_type_for_size (TREE_INT_CST_LOW (TYPE_SIZE (typ1)), + TYPE_UNSIGNED (typ2)); + } + finish_record_type (gnu_cico_return_type, nreverse (gnu_cico_field_list), 0, false); diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc index e02804b..a7254fe 100644 --- a/gcc/ada/gcc-interface/trans.cc +++ b/gcc/ada/gcc-interface/trans.cc @@ -4049,7 +4049,7 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) tree gnu_decl; /* Skip any entries that have been already filled in; they must - correspond to In Out parameters. */ + correspond to In Out parameters or previous Out parameters. */ while (gnu_cico_entry && TREE_VALUE (gnu_cico_entry)) gnu_cico_entry = TREE_CHAIN (gnu_cico_entry); @@ -4059,11 +4059,22 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) if (DECL_BY_REF_P (gnu_decl)) gnu_decl = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_decl); - /* Do any needed references for padded types. */ - TREE_VALUE (gnu_cico_entry) - = convert (TREE_TYPE (TREE_PURPOSE (gnu_cico_entry)), gnu_decl); + TREE_VALUE (gnu_cico_entry) = gnu_decl; } + + /* Finally, ensure type consistency between TREE_PURPOSE and TREE_VALUE + so that the assignment of the latter to the former can be done. */ + tree gnu_cico_entry = gnu_cico_list; + while (gnu_cico_entry) + { + if (!VOID_TYPE_P (TREE_VALUE (gnu_cico_entry))) + TREE_VALUE (gnu_cico_entry) + = convert (TREE_TYPE (TREE_PURPOSE (gnu_cico_entry)), + TREE_VALUE (gnu_cico_entry)); + gnu_cico_entry = TREE_CHAIN (gnu_cico_entry); + } } + else vec_safe_push (gnu_return_label_stack, NULL_TREE); @@ -4161,9 +4172,13 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) } } - /* Otherwise, if this is a procedure or a function which does not return - by invisible reference, we can do a direct block-copy out. */ - else + /* Otherwise, if this is a procedure or a function that does not return + by invisible reference, we can do a direct block-copy out, but we do + not need to do it for a null initialization procedure when the _Init + parameter is not passed in since we would copy uninitialized bits. */ + else if (!(Is_Null_Init_Proc (gnat_subprog) + && list_length (gnu_cico_list) == 1 + && TREE_CODE (TREE_VALUE (gnu_cico_list)) == VAR_DECL)) { tree gnu_retval; diff --git a/gcc/ada/gcc-interface/utils.cc b/gcc/ada/gcc-interface/utils.cc index 23737c3..7324bee 100644 --- a/gcc/ada/gcc-interface/utils.cc +++ b/gcc/ada/gcc-interface/utils.cc @@ -1225,7 +1225,6 @@ make_packable_type (tree type, bool in_record, unsigned int max_align) Note that we rely on the pointer equality created here for TYPE_NAME to look through conversions in various places. */ TYPE_NAME (new_type) = TYPE_NAME (type); - TYPE_PACKED (new_type) = 1; TYPE_JUSTIFIED_MODULAR_P (new_type) = TYPE_JUSTIFIED_MODULAR_P (type); TYPE_CONTAINS_TEMPLATE_P (new_type) = TYPE_CONTAINS_TEMPLATE_P (type); TYPE_REVERSE_STORAGE_ORDER (new_type) = TYPE_REVERSE_STORAGE_ORDER (type); @@ -1240,6 +1239,8 @@ make_packable_type (tree type, bool in_record, unsigned int max_align) new_size = ceil_pow2 (size); new_align = MIN (new_size, BIGGEST_ALIGNMENT); SET_TYPE_ALIGN (new_type, new_align); + /* build_aligned_type needs to be able to adjust back the alignment. */ + TYPE_PACKED (new_type) = 0; } else { @@ -1261,6 +1262,7 @@ make_packable_type (tree type, bool in_record, unsigned int max_align) if (max_align > 0 && new_align > max_align) new_align = max_align; SET_TYPE_ALIGN (new_type, MIN (align, new_align)); + TYPE_PACKED (new_type) = 1; } TYPE_USER_ALIGN (new_type) = 1; diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 79fb225..b0a14b0 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -19,7 +19,7 @@ @copying @quotation -GNAT Reference Manual , Jun 27, 2025 +GNAT Reference Manual , Jul 03, 2025 AdaCore @@ -7548,13 +7548,33 @@ Syntax: pragma Short_Circuit_And_Or; @end example -This configuration pragma causes any occurrence of the AND operator applied to -operands of type Standard.Boolean to be short-circuited (i.e. the AND operator -is treated as if it were AND THEN). Or is similarly treated as OR ELSE. This -may be useful in the context of certification protocols requiring the use of -short-circuited logical operators. If this configuration pragma occurs locally -within the file being compiled, it applies only to the file being compiled. +This configuration pragma causes the predefined AND and OR operators of +type Standard.Boolean to have short-circuit semantics. That is, they +behave like AND THEN and OR ELSE; the right-hand side is not evaluated +if the left-hand side determines the result. This may be useful in the +context of certification protocols requiring the use of short-circuited +logical operators. + There is no requirement that all units in a partition use this option. +However, mixing of short-circuit and non-short-circuit semantics can be +confusing. Therefore, the recommended use is to put the pragma in a +configuration file that applies to the whole program. Alternatively, if +you have a legacy library that should not use this pragma, you can put +it in a separate library project that does not use the pragma. +In any case, fine-grained mixing of the different semantics is not +recommended. If pragma @code{Short_Circuit_And_Or} is specified, then it +is illegal to rename the predefined Boolean AND and OR, or to pass +them to generic formal functions; this corresponds to the fact that +AND THEN and OR ELSE cannot be renamed nor passed as generic formal +functions. + +Note that this pragma has no effect on other logical operators – +predefined operators of modular types, array-of-boolean types and types +derived from Standard.Boolean, nor user-defined operators. + +See also the pragma @code{Unevaluated_Use_Of_Old} and the restriction +@code{No_Direct_Boolean_Operators}, which may be useful in conjunction +with @code{Short_Circuit_And_Or}. @node Pragma Short_Descriptors,Pragma Side_Effects,Pragma Short_Circuit_And_Or,Implementation Defined Pragmas @anchor{gnat_rm/implementation_defined_pragmas pragma-short-descriptors}@anchor{ed} diff --git a/gcc/ada/mutably_tagged.adb b/gcc/ada/mutably_tagged.adb index 153d168..b04ba92 100644 --- a/gcc/ada/mutably_tagged.adb +++ b/gcc/ada/mutably_tagged.adb @@ -40,6 +40,7 @@ with Sinfo.Nodes; use Sinfo.Nodes; with Sinfo.Utils; use Sinfo.Utils; with Stringt; use Stringt; with Tbuild; use Tbuild; +with Uintp; use Uintp; package body Mutably_Tagged is @@ -205,21 +206,41 @@ package body Mutably_Tagged is Mut_Tag_Typ : Entity_Id) return Node_Id is Loc : constant Source_Ptr := Sloc (New_Typ); + + CW_Size : constant Uint := RM_Size (Mut_Tag_Typ); + + function To_Mixed_Case (S : String) return String; + -- convert string to mixed case + + ------------------- + -- To_Mixed_Case -- + ------------------- + + function To_Mixed_Case (S : String) return String is + Buf : Bounded_String; + begin + Append (Buf, S); + Set_Casing (Buf, Mixed_Case); + return +Buf; + end To_Mixed_Case; + + -- Start of processing for Make_CW_Size_Compile_Check + begin - -- Generate a string literal for New_Typ's name which is needed for - -- printing within the Compile_Time_Error. + -- Build a Compile_Time_Error pragma in order to defer the + -- (compile-time) size check until after the back end has + -- determined sizes. + -- + -- It would be nice if we could somehow include the value of + -- New_Type'Size in the error message, but it is not clear how to + -- accomplish that with the current FE/BE interfaces. + + -- Get New_Typ's name (in mixed case) into the name buffer; + -- this is used immediately afterwards in the Make_Pragma call. Get_Decoded_Name_String (Chars (New_Typ)); Set_Casing (Mixed_Case); - -- Build a pragma Compile_Time_Error to force the backend to - -- preform appropriate sizing checks. - - -- Generate: - -- pragma Compile_Time_Error - -- (New_Typ'Size < Mut_Tag_Typ'Size, - -- "class size for by-reference type ""New_Typ"" too small") - return Make_Pragma (Loc, Chars => Name_Compile_Time_Error, @@ -233,19 +254,18 @@ package body Mutably_Tagged is Prefix => New_Occurrence_Of (New_Typ, Loc)), Right_Opnd => - Make_Integer_Literal (Loc, - RM_Size (Mut_Tag_Typ))))), + Make_Integer_Literal (Loc, CW_Size)))), Make_Pragma_Argument_Association (Loc, Expression => - - -- Is it possible to print the size of New_Typ via - -- Validate_Compile_Time_Warning_Or_Error after the back-end - -- has run to generate the error message manually ??? - Make_String_Literal (Loc, - "class size for by-reference type """ - & To_String (String_From_Name_Buffer) - & """ too small")))); + To_String (String_From_Name_Buffer) + & "'Size exceeds " + & To_Mixed_Case ( + To_String (Fully_Qualified_Name_String + (Find_Specific_Type (Mut_Tag_Typ), + Append_NUL => False))) + & "'Size'Class limit of " + & UI_Image (CW_Size))))); end Make_CW_Size_Compile_Check; ------------------------------------ diff --git a/gcc/ada/sem_aux.ads b/gcc/ada/sem_aux.ads index 5a63002..aad5d32 100644 --- a/gcc/ada/sem_aux.ads +++ b/gcc/ada/sem_aux.ads @@ -105,7 +105,7 @@ package Sem_Aux is -- this is equivalent to First_Entity. The exception arises for tagged -- types, where the tag itself is prepended to the front of the entity -- chain, so the First_Discriminant function steps past the tag if it is - -- present. When called on a private type with unknown discriminants, the + -- present. When called on a private type with unknown discriminants, the -- function always returns Empty. -- WARNING: There is a matching C declaration of this subprogram in fe.h diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 1e88ef4..99acbf8 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -4634,6 +4634,7 @@ package body Sem_Ch13 is when Aspect_Designated_Storage_Model => if not All_Extensions_Allowed then + Error_Msg_Name_1 := Nam; Error_Msg_GNAT_Extension ("aspect %", Loc); goto Continue; @@ -8861,6 +8862,43 @@ package body Sem_Ch13 is Num_Repped_Components : Nat := 0; Num_Unrepped_Components : Nat := 0; + function Unchecked_Union_Pragma_Pending return Boolean; + -- Return True in the corner case of an Unchecked_Union pragma + -- occuring after the record representation clause (which + -- means that Is_Unchecked_Union will return False for Rectype, + -- even though it would return True if called later after the + -- pragma is analyzed). + + ------------------------------------ + -- Unchecked_Union_Pragma_Pending -- + ------------------------------------ + + function Unchecked_Union_Pragma_Pending return Boolean is + Decl_List_Element : Node_Id := N; + Pragma_Arg : Node_Id; + begin + while Present (Decl_List_Element) loop + if Nkind (Decl_List_Element) = N_Pragma + and then Get_Pragma_Id (Decl_List_Element) = + Pragma_Unchecked_Union + and then not Is_Empty_List (Pragma_Argument_Associations + (Decl_List_Element)) + then + Pragma_Arg := Get_Pragma_Arg + (First (Pragma_Argument_Associations + (Decl_List_Element))); + if Nkind (Pragma_Arg) = N_Identifier + and then Chars (Pragma_Arg) = Chars (Rectype) + then + return True; + end if; + end if; + + Next (Decl_List_Element); + end loop; + return False; + end Unchecked_Union_Pragma_Pending; + begin -- First count number of repped and unrepped components @@ -8899,8 +8937,10 @@ package body Sem_Ch13 is -- Ignore discriminant in unchecked union, since it is -- not there, and cannot have a component clause. - and then (not Is_Unchecked_Union (Rectype) - or else Ekind (Comp) /= E_Discriminant) + and then (Ekind (Comp) /= E_Discriminant + or else not (Is_Unchecked_Union (Rectype) + or else + Unchecked_Union_Pragma_Pending)) then Error_Msg_Sloc := Sloc (Comp); Error_Msg_NE @@ -11406,24 +11446,16 @@ package body Sem_Ch13 is ---------------------------------- procedure Check_Aspect_At_Freeze_Point (ASN : Node_Id) is - Ident : constant Node_Id := Identifier (ASN); - -- Identifier (use Entity field to save expression) - Expr : constant Node_Id := Expression (ASN); - -- For cases where using Entity (Identifier) doesn't work - A_Id : constant Aspect_Id := Get_Aspect_Id (Chars (Ident)); + A_Id : constant Aspect_Id := Get_Aspect_Id (Chars (Identifier (ASN))); T : Entity_Id := Empty; -- Type required for preanalyze call begin - -- On entry to this procedure, Entity (Ident) contains a copy of the - -- original expression from the aspect, saved for this purpose. - - -- On exit from this procedure Entity (Ident) is unchanged, still - -- containing that copy, but Expression (Ident) is a preanalyzed copy - -- of the expression, preanalyzed just after the freeze point. + -- On exit from this procedure, Expression (ASN) is a copy of the + -- original expression, preanalyzed just after the freeze point. -- Make a copy of the expression to be preanalyzed diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index db892d0..54066b4 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -4270,6 +4270,40 @@ package body Sem_Ch8 is Local_Restrict.Check_Actual_Subprogram_For_Instance (Actual_Subp_Name => Nam, Formal_Subp => Formal_Spec); end if; + + -- If pragma Short_Circuit_And_Or is specified, then we give an error + -- for renaming an operator that is made short circuit. + -- For example, this is illegal: + -- + -- function My_And (X, Y: Boolean) return Boolean renames "and"; + -- + -- if "and" denotes the usual predefined Boolean operator. Otherwise, + -- the semantics are confusing (sometimes short circuit, and sometimes + -- not, for calls to My_And). If we ever relax this rule, we will need + -- to clean up that run-time semantics. + + if Short_Circuit_And_Or + and then Chars (Old_S) in Name_Op_And | Name_Op_Or + and then In_Extended_Main_Source_Unit (N) + and then Etype (Old_S) = Standard_Boolean + and then Is_Intrinsic_Subprogram (Old_S) + then + if Comes_From_Source (N) then + Error_Msg_N + ("pragma Short_Circuit_And_Or disallows renaming of " & + "operator", N); + + -- Same error in case of an instantiation with My_And => "and" + + elsif Present (Corresponding_Formal_Spec (N)) then + Error_Msg_N + ("pragma Short_Circuit_And_Or disallows passing of " & + "operator as a generic actual", N); + + else + raise Program_Error; + end if; + end if; end Analyze_Subprogram_Renaming; ------------------------- diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 96e8da6..e44994a 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -12463,16 +12463,6 @@ package body Sem_Res is Orig_N := Original_Node (Expression (Orig_N)); Orig_T := Target_Typ; - -- If the node is part of a larger expression, the Target_Type - -- may not be the original type of the node if the context is a - -- condition. Recover original type to see if conversion is needed. - - if Is_Boolean_Type (Orig_T) - and then Nkind (Parent (N)) in N_Op - then - Orig_T := Etype (Parent (N)); - end if; - -- If we have an entity name, then give the warning if the entity -- is the right type, or if it is a loop parameter covered by the -- original type (that's needed because loop parameters have an @@ -12548,6 +12538,16 @@ package body Sem_Res is then null; + -- Do not warn if original source-level conversion was + -- between two different types. + + elsif Nkind (Original_Node (N)) = N_Type_Conversion + and then + Base_Type (Etype (Subtype_Mark (Original_Node (N)))) + /= Base_Type (Etype (Expression (Original_Node (N)))) + then + null; + -- Here we give the redundant conversion warning. If it is an -- entity, give the name of the entity in the message. If not, -- just mention the expression. |