public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r14-8456] modula2: detect string and pointer formal and actual parameter incompatibility
@ 2024-01-26 19:05 Gaius Mulley
  0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2024-01-26 19:05 UTC (permalink / raw)
  To: gcc-cvs

https://gcc.gnu.org/g:eb619490b01baa2fc2b5ee98d15516c4a2372e74

commit r14-8456-geb619490b01baa2fc2b5ee98d15516c4a2372e74
Author: Gaius Mulley <gaiusmod2@gmail.com>
Date:   Fri Jan 26 19:04:48 2024 +0000

    modula2: detect string and pointer formal and actual parameter incompatibility
    
    This patch improves the location accuracy of parameters and fixes bugs
    in parameter checking in M2Check.  It also corrects the location
    of constant declarations.
    
    gcc/m2/ChangeLog:
    
            * gm2-compiler/M2Check.mod (dumpIndice): New procedure.
            (dumpIndex): New procedure.
            (dumptInfo): New procedure.
            (buildError4): Add comment and pass formal and actual to
            MetaError4.  Improve text describing error.
            (buildError2): Generate different error descriptions for
            the three error kinds.
            (checkConstMeta): Add block comment.  Add more meta checks
            and call doCheckPair to complete string const checking.
            Add tinfo parameter.
            (checkConstEquivalence): Add tinfo parameter.
            * gm2-compiler/M2GCCDeclare.mod (PrintVerboseFromList):
            Print the length of a const string.
            * gm2-compiler/M2GenGCC.mod (CodeParam): Remove parameters
            op1, op2 and op3.
            (doParam): Add paramtok parameter.  Use paramtok instead rather
            than CurrentQuadToken.
            (CodeParam): Rewrite.
            * gm2-compiler/M2Quads.mod (CheckProcedureParameters):
            Add comments explaining that const strings are not checked
            in M2Quads.mod.
            (FailParameter): Use MetaErrorT2 with tokpos rather than
            MetaError2.
            (doBuildBinaryOp): Assign OldPos and OperatorPos before the
            IF block.
            * gm2-compiler/SymbolTable.mod (PutConstString): Add call to
            InitWhereDeclaredTok.
    
    gcc/testsuite/ChangeLog:
    
            * gm2/pim/fail/badpointer4.mod: New test.
            * gm2/pim/fail/strconst.def: New test.
    
    Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>

Diff:
---
 gcc/m2/gm2-compiler/M2Check.mod            | 108 ++++++++++++++++++++++++-----
 gcc/m2/gm2-compiler/M2GCCDeclare.mod       |   5 +-
 gcc/m2/gm2-compiler/M2GenGCC.mod           |  61 ++++++++--------
 gcc/m2/gm2-compiler/M2Quads.mod            |  29 +++++---
 gcc/m2/gm2-compiler/SymbolTable.mod        |   1 +
 gcc/testsuite/gm2/pim/fail/badpointer4.mod |  20 ++++++
 gcc/testsuite/gm2/pim/fail/strconst.def    |   6 ++
 7 files changed, 169 insertions(+), 61 deletions(-)

diff --git a/gcc/m2/gm2-compiler/M2Check.mod b/gcc/m2/gm2-compiler/M2Check.mod
index d4560819a5dc..a296766ba35c 100644
--- a/gcc/m2/gm2-compiler/M2Check.mod
+++ b/gcc/m2/gm2-compiler/M2Check.mod
@@ -33,8 +33,8 @@ IMPLEMENTATION MODULE M2Check ;
 *)
 
 FROM M2System IMPORT IsSystemType, IsGenericSystemType, IsSameSize, IsComplexN ;
-FROM M2Base IMPORT IsParameterCompatible, IsAssignmentCompatible, IsExpressionCompatible, IsComparisonCompatible, IsBaseType, IsMathType, ZType, CType, RType, IsComplexType ;
-FROM Indexing IMPORT Index, InitIndex, GetIndice, PutIndice, KillIndex, HighIndice, LowIndice, IncludeIndiceIntoIndex ;
+FROM M2Base IMPORT IsParameterCompatible, IsAssignmentCompatible, IsExpressionCompatible, IsComparisonCompatible, IsBaseType, IsMathType, ZType, CType, RType, IsComplexType, Char ;
+FROM Indexing IMPORT Index, InitIndex, GetIndice, PutIndice, KillIndex, HighIndice, LowIndice, IncludeIndiceIntoIndex, ForeachIndiceInIndexDo ;
 FROM M2Error IMPORT Error, InternalError, NewError, ErrorString, ChainError ;
 FROM M2MetaError IMPORT MetaErrorStringT2, MetaErrorStringT3, MetaErrorStringT4, MetaString2, MetaString3, MetaString4 ;
 FROM StrLib IMPORT StrEqual ;
@@ -48,6 +48,7 @@ FROM SymbolConversion IMPORT Mod2Gcc ;
 FROM DynamicStrings IMPORT String, InitString, KillString ;
 FROM M2LexBuf IMPORT GetTokenNo ;
 FROM Storage IMPORT ALLOCATE ;
+FROM SYSTEM IMPORT ADR ;
 FROM libc IMPORT printf ;
 
 
@@ -101,6 +102,52 @@ VAR
    errors       : Index ;
 
 
+(*
+   dumpIndice -
+*)
+
+PROCEDURE dumpIndice (ptr: pair) ;
+BEGIN
+   printf (" left (%d), right (%d), status ",
+           ptr^.left, ptr^.right);
+   CASE ptr^.pairStatus OF
+
+   true   :  printf ("true") |
+   false  :  printf ("false") |
+   unknown:  printf ("unknown") |
+   visited:  printf ("visited") |
+   unused :  printf ("unused")
+
+   END ;
+   printf ("\n")
+END dumpIndice ;
+
+
+(*
+   dumpIndex -
+*)
+
+PROCEDURE dumpIndex (name: ARRAY OF CHAR; index: Index) ;
+BEGIN
+   printf ("status: %s\n", ADR (name)) ;
+   ForeachIndiceInIndexDo (index, dumpIndice)
+END dumpIndex ;
+
+
+(*
+   dumptInfo -
+*)
+
+PROCEDURE dumptInfo (t: tInfo) ;
+BEGIN
+   printf ("actual (%d), formal (%d), left (%d), right (%d), procedure (%d)\n",
+           t^.actual, t^.formal, t^.left, t^.right, t^.procedure) ;
+   dumpIndex ('visited', t^.visited) ;
+   dumpIndex ('resolved', t^.resolved) ;
+   dumpIndex ('unresolved', t^.unresolved)
+END dumptInfo ;
+
+
 (*
    isKnown - returns BOOLEAN:TRUE if result is status:true or status:false.
 *)
@@ -283,7 +330,8 @@ END firstTime ;
 
 
 (*
-   buildError4 -
+   buildError4 - generate a MetaString4 error.  This is only used when checking
+                 parameter compatibility.
 *)
 
 PROCEDURE buildError4 (tinfo: tInfo; left, right: CARDINAL) ;
@@ -300,7 +348,7 @@ BEGIN
             of paramters passed to ParameterTypeCompatible.  *)
          s := MetaString4 (tinfo^.format,
                            tinfo^.procedure,
-                           tinfo^.left, tinfo^.right,
+                           tinfo^.formal, tinfo^.actual,
                            tinfo^.nth) ;
          ErrorString (tinfo^.error, s)
       END ;
@@ -308,7 +356,8 @@ BEGIN
       IF (left # tinfo^.left) OR (right # tinfo^.right)
       THEN
          tinfo^.error := ChainError (tinfo^.token, tinfo^.error) ;
-         s := MetaString2 (InitString ("{%1Ead} and {%2ad} are incompatible in this context"), left, right) ;
+         s := MetaString2 (InitString ("{%1Ead} and {%2ad} are incompatible as formal and actual procedure parameters"),
+                           left, right) ;
          ErrorString (tinfo^.error, s)
       END
    END
@@ -316,7 +365,7 @@ END buildError4 ;
 
 
 (*
-   buildError2 -
+   buildError2 - generate a MetaString2 error.  This is called by all three kinds of errors.
 *)
 
 PROCEDURE buildError2 (tinfo: tInfo; left, right: CARDINAL) ;
@@ -327,17 +376,26 @@ BEGIN
    THEN
       IF tinfo^.error = NIL
       THEN
-         (* need to create top level error message first.  *)
+         (* Need to create top level error message first.  *)
          tinfo^.error := NewError (tinfo^.token) ;
          s := MetaString2 (tinfo^.format,
                            tinfo^.left, tinfo^.right) ;
          ErrorString (tinfo^.error, s)
       END ;
-      (* and also generate a sub error containing detail.  *)
+      (* Also generate a sub error containing detail.  *)
       IF (left # tinfo^.left) OR (right # tinfo^.right)
       THEN
          tinfo^.error := ChainError (tinfo^.token, tinfo^.error) ;
-         s := MetaString2 (InitString ("{%1Ead} and {%2ad} are incompatible in this context"), left, right) ;
+         CASE tinfo^.kind OF
+
+         parameter:  s := MetaString2 (InitString ("{%1Ead} and {%2ad} are incompatible as formal and actual procedure parameters"),
+                                       left, right) |
+         assignment: s := MetaString2 (InitString ("{%1Ead} and {%2ad} are assignment incompatible"),
+                                       left, right) |
+         expression: s := MetaString2 (InitString ("{%1Ead} and {%2ad} are expression incompatible"),
+                                       left, right)
+
+         END ;
          ErrorString (tinfo^.error, s)
       END
    END
@@ -548,11 +606,13 @@ END checkVarEquivalence ;
 
 
 (*
-   checkConstMeta -
+   checkConstMeta - performs a very course grained check against
+                    obviously incompatible type kinds.
+                    If left is a const string then it checks right against char.
 *)
 
-PROCEDURE checkConstMeta  (result: status;
-                           left, right: CARDINAL) : status ;
+PROCEDURE checkConstMeta (result: status; tinfo: tInfo;
+                          left, right: CARDINAL) : status ;
 VAR
    typeRight: CARDINAL ;
 BEGIN
@@ -566,9 +626,12 @@ BEGIN
       IF typeRight = NulSym
       THEN
          RETURN result
-      ELSIF IsSet (typeRight) OR IsEnumeration (typeRight)
+      ELSIF IsSet (typeRight) OR IsEnumeration (typeRight) OR IsProcedure (typeRight) OR
+            IsRecord (typeRight)
       THEN
          RETURN false
+      ELSE
+         RETURN doCheckPair (result, tinfo, Char, typeRight)
       END
    END ;
    RETURN result
@@ -583,7 +646,7 @@ END checkConstMeta ;
                            early on.  For example adding a string to an enum or set.
 *)
 
-PROCEDURE checkConstEquivalence (result: status;
+PROCEDURE checkConstEquivalence (result: status; tinfo: tInfo;
                                  left, right: CARDINAL) : status ;
 BEGIN
    IF isFalse (result)
@@ -595,10 +658,10 @@ BEGIN
       RETURN true
    ELSIF IsConst (left)
    THEN
-      RETURN checkConstMeta (result, left, right)
+      RETURN checkConstMeta (result, tinfo, left, right)
    ELSIF IsConst (right)
    THEN
-      RETURN checkConstMeta (result, right, left)
+      RETURN checkConstMeta (result, tinfo, right, left)
    END ;
    RETURN result
 END checkConstEquivalence ;
@@ -715,7 +778,7 @@ BEGIN
    THEN
       RETURN return (true, tinfo, left, right)
    ELSE
-      result := checkConstEquivalence (unknown, left, right) ;
+      result := checkConstEquivalence (unknown, tinfo, left, right) ;
       IF NOT isKnown (result)
       THEN
          result := checkVarEquivalence (unknown, tinfo, left, right) ;
@@ -1320,10 +1383,15 @@ VAR
    result     : status ;
    left, right: CARDINAL ;
 BEGIN
+   IF debugging
+   THEN
+      dumptInfo (tinfo)
+   END ;
    WHILE get (tinfo^.unresolved, left, right, unknown) DO
       IF debugging
       THEN
-         printf ("doCheck (%d, %d)\n", left, right)
+         printf ("doCheck (%d, %d)\n", left, right) ;
+         dumptInfo (tinfo)
       END ;
       (*
       IF in (tinfo^.visited, left, right)
@@ -1561,6 +1629,10 @@ BEGIN
    tinfo^.strict := FALSE ;
    tinfo^.isin := FALSE ;
    include (tinfo^.unresolved, actual, formal, unknown) ;
+   IF debugging
+   THEN
+      dumptInfo (tinfo)
+   END ;
    IF doCheck (tinfo)
    THEN
       deconstruct (tinfo) ;
diff --git a/gcc/m2/gm2-compiler/M2GCCDeclare.mod b/gcc/m2/gm2-compiler/M2GCCDeclare.mod
index 643374db0a64..dae5a6b34bd2 100644
--- a/gcc/m2/gm2-compiler/M2GCCDeclare.mod
+++ b/gcc/m2/gm2-compiler/M2GCCDeclare.mod
@@ -4060,6 +4060,7 @@ END PrintProcedure ;
 
 PROCEDURE PrintVerboseFromList (l: List; i: CARDINAL) ;
 VAR
+   len,
    type,
    low,
    high,
@@ -4227,7 +4228,9 @@ BEGIN
          ELSIF IsConstStringCnul (sym)
          THEN
             printf0(' a nul terminated C string')
-         END
+         END ;
+         len := GetStringLength (sym) ;
+         printf1(' length %d', len)
       ELSIF IsConstructor(sym)
       THEN
          printf0(' constant constructor ') ;
diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod
index ced4724f4c0f..92ca39f71b58 100644
--- a/gcc/m2/gm2-compiler/M2GenGCC.mod
+++ b/gcc/m2/gm2-compiler/M2GenGCC.mod
@@ -520,7 +520,7 @@ BEGIN
    IndrXOp            : CodeIndrX (q, op1, op2, op3) |
    XIndrOp            : CodeXIndr (q) |
    CallOp             : CodeCall (CurrentQuadToken, op3) |
-   ParamOp            : CodeParam (q, op1, op2, op3) |
+   ParamOp            : CodeParam (q) |
    FunctValueOp       : CodeFunctValue (location, op1) |
    AddrOp             : CodeAddr (q, op1, op3) |
    SizeOp             : CodeSize (op1, op3) |
@@ -2376,14 +2376,14 @@ END FoldMakeAdr ;
              procedure, op2.  The number of the parameter is op1.
 *)
 
-PROCEDURE doParam (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+PROCEDURE doParam (quad: CARDINAL; paramtok: CARDINAL; op1, op2, op3: CARDINAL) ;
 VAR
    location: location_t ;
 BEGIN
-   location := TokenToLocation (CurrentQuadToken) ;
-   DeclareConstant (CurrentQuadToken, op3) ;
-   DeclareConstructor (CurrentQuadToken, quad, op3) ;
-   BuildParam (location, CheckConvertCoerceParameter (CurrentQuadToken, op1, op2, op3))
+   location := TokenToLocation (paramtok) ;
+   DeclareConstant (paramtok, op3) ;
+   DeclareConstructor (paramtok, quad, op3) ;
+   BuildParam (location, CheckConvertCoerceParameter (paramtok, op1, op2, op3))
 END doParam ;
 
 
@@ -2433,7 +2433,7 @@ BEGIN
       REPEAT
          IF (op=ParamOp) AND (op1>0)
          THEN
-            doParam(n, op1, op2, op3)
+            doParam (tokenno, n, op1, op2, op3)
          ELSIF op=CallOp
          THEN
             procedure := op3
@@ -2499,8 +2499,21 @@ END FoldBuiltinFunction ;
                NOTE that we CAN ignore ModeOfAddr though
 *)
 
-PROCEDURE CodeParam (quad: CARDINAL; nth, procedure, parameter: CARDINAL) ;
+PROCEDURE CodeParam (quad: CARDINAL) ;
+VAR
+   nopos,
+   procedure,
+   parameter,
+   parampos  : CARDINAL ;
+   nth       : CARDINAL ;
+   compatible,
+   overflow  : BOOLEAN ;
+   op        : QuadOperator ;
 BEGIN
+   GetQuadOtok (quad, parampos, op,
+                nth, procedure, parameter, overflow,
+                nopos, nopos, nopos) ;
+   compatible := TRUE ;
    IF nth=0
    THEN
       CodeBuiltinFunction (quad, nth, procedure, parameter)
@@ -2509,41 +2522,27 @@ BEGIN
       THEN
          IF (nth <= NoOfParam (procedure))
          THEN
-            IF IsVarParam (procedure, nth) AND
-               (NOT ParameterTypeCompatible (CurrentQuadToken,
-                                             'parameter incompatibility when attempting to pass actual parameter {%2ad} to a {%kVAR} formal parameter {%3Ead} during call to procedure {%1ad}',
-                                             procedure, GetNthParam (procedure, nth), parameter, nth, TRUE))
-            THEN
-
-            ELSIF (NOT IsVarParam (procedure, nth)) AND
-               (NOT ParameterTypeCompatible (CurrentQuadToken,
-                                             'parameter incompatibility when attempting to pass actual parameter {%3Ead} to the {%4EN} formal parameter {%2ad} during call to procedure {%1ad}',
-                                             procedure, GetNthParam (procedure, nth), parameter, nth, FALSE))
-            THEN
-               (* use the AssignmentTypeCompatible as the rules are for assignment for non var parameters.  *)
-            ELSE
-               (* doParam (quad, nth, procedure, parameter) *)    (* --fixme--  enable when M2Check works.  *)
-            END
+            compatible := ParameterTypeCompatible (parampos,
+                                                   'parameter incompatibility when attempting to pass actual parameter {%2ad} to a {%kVAR} formal parameter {%3Ead} during call to procedure {%1ad}',
+                                                   procedure, GetNthParam (procedure, nth),
+                                                   parameter, nth, IsVarParam (procedure, nth))
          END
-      ELSE
-         (* doParam (quad, nth, procedure, parameter)     *)    (* --fixme--  enable when M2Check works.  *)
       END ;
 
-      (* --fixme  remove B EGIN  *)
       IF (nth <= NoOfParam (procedure)) AND
          IsVarParam (procedure, nth) AND IsConst (parameter)
       THEN
-         MetaErrorT1 (CurrentQuadToken,
+         MetaErrorT1 (parampos,
                       'cannot pass a constant {%1Ead} as a VAR parameter', parameter)
       ELSIF IsAModula2Type (parameter)
       THEN
-         MetaErrorT2 (CurrentQuadToken,
+         MetaErrorT2 (parampos,
                       'cannot pass a type {%1Ead} as a parameter to procedure {%2ad}',
                       parameter, procedure)
-      ELSE
-         doParam (quad, nth, procedure, parameter)
+      ELSIF compatible
+      THEN
+         doParam (quad, parampos, nth, procedure, parameter)
       END
-      (* --fixme  remove E ND  once M2Check works.  *)
    END
 END CodeParam ;
 
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 45e2769af793..a666a4e3a5bd 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -3606,7 +3606,6 @@ BEGIN
       PopTrwtok (Des, w, destok) ;
       MarkAsWrite (w) ;
       CheckCompatibleWithBecomes (Des, Exp, destok, exptok) ;
-      combinedtok := MakeVirtualTok (becomesTokNo, destok, exptok) ;
       IF DebugTokPos
       THEN
          MetaErrorT1 (becomesTokNo, 'becomestok {%1Oad}', Des) ;
@@ -3629,7 +3628,7 @@ BEGIN
          CheckBecomesMeta (Des, Exp, combinedtok, destok, exptok)
       END ;
       (* Simple assignment.  *)
-      MoveWithMode (becomesTokNo, Des, Exp, Array, destok, exptok, checkOverflow) ;
+      MoveWithMode (combinedtok, Des, Exp, Array, destok, exptok, checkOverflow) ;
       IF checkTypes
       THEN
          (*
@@ -5428,13 +5427,14 @@ BEGIN
                               Actual, FormalI, Proc, i)
             ELSIF IsConstString (Actual)
             THEN
-               IF (GetStringLength (Actual) = 0)   (* if = 0 then it maybe unknown at this time *)
+               IF (GetStringLength (Actual) = 0)   (* If = 0 then it maybe unknown at this time.  *)
                THEN
-                  (* dont check this yet *)
+                  (* We dont check this yet, it is checked in M2GenGCC.mod:CodeParam
+                     after the string has been created.  *)
                ELSIF IsArray(GetDType(FormalI)) AND (GetSType(GetDType(FormalI))=Char)
                THEN
-                  (* allow string literals to be passed to ARRAY [0..n] OF CHAR *)
-               ELSIF (GetStringLength(Actual) = 1)   (* if = 1 then it maybe treated as a char *)
+                  (* Allow string literals to be passed to ARRAY [0..n] OF CHAR.  *)
+               ELSIF (GetStringLength(Actual) = 1)   (* If = 1 then it maybe treated as a char.  *)
                THEN
                   CheckParameter (paramtok, Actual, Dim, FormalI, Proc, i, NIL)
                ELSIF NOT IsUnboundedParam(Proc, i)
@@ -5864,8 +5864,9 @@ VAR
    ExpectType: CARDINAL ;
    s, s1, s2 : String ;
 BEGIN
-   MetaError2 ('parameter mismatch between the {%2N} parameter of procedure {%1Ead}',
-               ProcedureSym, ParameterNo) ;
+   MetaErrorT2 (tokpos,
+                'parameter mismatch between the {%2N} parameter of procedure {%1Ead}',
+                ProcedureSym, ParameterNo) ;
    s := InitString ('{%kPROCEDURE} {%1Eau} (') ;
    IF NoOfParam(ProcedureSym)>=ParameterNo
    THEN
@@ -5905,7 +5906,13 @@ BEGIN
    s := ConCat (s, Mark (InitString ('){%1Tau:% : {%1Tau}} ;'))) ;
    MetaErrorStringT1 (First, Dup (s), ProcedureSym) ;
    MetaErrorStringT1 (tokpos, s, ProcedureSym) ;
-   MetaError1 ('item being passed is {%1EDda} {%1Dad} of type {%1Dtsd}', Given)
+   IF GetLType (Given) = NulSym
+   THEN
+      MetaError1 ('item being passed is {%1EDda} {%1Dad}', Given)
+   ELSE
+      MetaError1 ('item being passed is {%1EDda} {%1Dad} of type {%1Dts}',
+                  Given)
+   END
 END FailParameter ;
 
 
@@ -12461,6 +12468,8 @@ BEGIN
       ELSE
          (* CheckForGenericNulSet(e1, e2, t1, t2) *)
       END ;
+      OldPos := OperatorPos ;
+      OperatorPos := MakeVirtualTok (OperatorPos, leftpos, rightpos) ;
       IF (Operator = PlusTok) AND IsConstString(left) AND IsConstString(right)
       THEN
          (* handle special addition for constant strings *)
@@ -12469,8 +12478,6 @@ BEGIN
          value := MakeConstLitString (OperatorPos, makekey (string (s))) ;
          s := KillString (s)
       ELSE
-         OldPos := OperatorPos ;
-         OperatorPos := MakeVirtualTok (OperatorPos, leftpos, rightpos) ;
          IF checkTypes
          THEN
             BuildRange (InitTypesExpressionCheck (OperatorPos, left, right, FALSE, FALSE))
diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod b/gcc/m2/gm2-compiler/SymbolTable.mod
index e219980117e7..d939d581a640 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.mod
+++ b/gcc/m2/gm2-compiler/SymbolTable.mod
@@ -5373,6 +5373,7 @@ BEGIN
 
       ConstStringSym: ConstString.Length := LengthKey (contents) ;
                       ConstString.Contents := contents ;
+                      InitWhereDeclaredTok (tok, ConstString.At) ;
                       InitWhereFirstUsedTok (tok, ConstString.At) |
 
       ConstVarSym   : (* ok altering this to ConstString *)
diff --git a/gcc/testsuite/gm2/pim/fail/badpointer4.mod b/gcc/testsuite/gm2/pim/fail/badpointer4.mod
new file mode 100644
index 000000000000..b5fb8ad89682
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/badpointer4.mod
@@ -0,0 +1,20 @@
+MODULE badpointer4 ;
+
+FROM DynamicStrings IMPORT String ;
+FROM strconst IMPORT Hello ;
+
+
+PROCEDURE testproc (s: String) ;
+BEGIN
+END testproc ;
+
+
+PROCEDURE foo ;
+BEGIN
+   testproc (Hello)
+END foo ;
+
+
+BEGIN
+   foo
+END badpointer4.
diff --git a/gcc/testsuite/gm2/pim/fail/strconst.def b/gcc/testsuite/gm2/pim/fail/strconst.def
new file mode 100644
index 000000000000..867e00665070
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/strconst.def
@@ -0,0 +1,6 @@
+DEFINITION MODULE strconst ;
+
+CONST
+   Hello = "hello world" ;
+
+END strconst.

^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2024-01-26 19:05 UTC | newest]

Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2024-01-26 19:05 [gcc r14-8456] modula2: detect string and pointer formal and actual parameter incompatibility Gaius Mulley

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).