[Solved] How to determine if string list has been allocated

[rvk]

It could be because I didn’t create the class maybe?

Yes, you need to know how to use classes.

If you don't want to use the constructor you can look into static class functions.
An example is here https://www.freepascal.org/docs-html/ref/refsu30.html

Other nice tricks and explanations with the 'new' classes can be found in this paper:
https://castle-engine.io/modern_pascal

But... Why don't you want to create the class? What the idea behind that?
Maybe if we understand that we can find a better solution.

Anyway .. TStringList is a class and that needs to be created. No way around that. And in old TP you would do that in .Init. But then you NEED to call that Init before using it. That's always been the case. Also in old Turbo Pascal.

If you don't like that... don't use TStringList class but create your own StringList object.

[cdbc]

Hi
Ok, so you would like a "StringStack"...
I went and put a crude, no checks, quick'n dirty one together, while you were talking... 
Very crude and slow probably, but here it is:

Code: Pascal  [Select][+][-]

1. unit uStrStck;
2.  
3. {$mode ObjFPC}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Contnrs;
9.  
10. type
11.   { TStringStack }
12.   TStringStack = class(TObject)
13.   private
14.     fStack: TStack;
15.     function ssStrAlloc(aLen: cardinal): pchar;
16.     function ssStrCopy(aStr: pchar): string;
17.     procedure ssStrDispose(aStr: pchar);
18.     function ssStrFree(aStr: pchar): string;
19.     function ssStrLength(aStr: pchar): cardinal;
20.     function ssStrNew(aStr: string): pchar;
21.   public
22.     constructor Create;
23.     destructor Destroy; override;
24.     procedure Clear;
25.     function Count: ptrint;
26.     function IsEmpty: boolean;
27.     procedure Push(const anItem: string);
28.     function Pop: string;
29.     Function Peek: string;
30.   end;
31.  
32. implementation
33.  
34. { TStringStack }
35. function TStringStack.ssStrAlloc(aLen: cardinal): pchar;
36. begin
37.   inc(aLen,sizeof(cardinal));        // add 4 bytes
38.   getmem(result,aLen);               // get total memory
39.   fillchar(Result^,aLen,#0);         // initialize total memory to 0
40.   cardinal(pointer(result)^):= aLen; // set length @4 bytes before the actual datapointer
41.   inc(result,sizeof(cardinal));      // set point result to actual data
42. end;
43.  
44. function TStringStack.ssStrCopy(aStr: pchar): string;
45. var L: cardinal;
46. begin
47.   if aStr = nil then exit('');
48.   L:= ssStrLength(aStr)-1; { skip trailing #0 }
49.   SetLength(Result,L);
50.   move(aStr^,Result[1],L); { skip trailing #0 }
51. end;
52.  
53. procedure TStringStack.ssStrDispose(aStr: pchar);
54. begin
55.   if (aStr <> nil) then begin
56.     dec(aStr,sizeof(cardinal));
57.     freemem(aStr,cardinal(pointer(aStr)^));
58.   end;
59. end;
60.  
61. function TStringStack.ssStrFree(aStr: pchar): string;
62. begin
63.   if (aStr <> nil) then begin
64.     Result:= ssStrCopy(aStr);
65.     ssStrDispose(aStr);
66.   end else exit('');
67. end;
68.  
69. function TStringStack.ssStrLength(aStr: pchar): cardinal;
70. begin
71.   if aStr <> nil then Result:= cardinal(pointer(aStr - SizeOf(cardinal))^) - sizeof(cardinal)
72.   else Result:= 0;
73. end;
74.  
75. function TStringStack.ssStrNew(aStr: string): pchar;
76. var Len: longint;
77. begin
78.   Result:= nil;
79.   if aStr = '' then exit;
80.   Len:= Length(aStr)+1; { for the 0# }
81.   Result:= ssStrAlloc(Len);
82.   if Result <> nil then move(aStr[1],Result^,len); { includes terminating null #0 }
83. end;
84.  
85. constructor TStringStack.Create;
86. begin
87.   inherited Create;
88.   fStack:= TStack.Create;
89. end;
90.  
91. destructor TStringStack.Destroy;
92. begin
93.   clear;
94.   fStack.Free;
95.   inherited Destroy;
96. end;
97.  
98. procedure TStringStack.Clear;
99. begin
100.   while not IsEmpty do ssStrDispose(fStack.Pop);
101. end;
102.  
103. function TStringStack.Count: ptrint;
104. begin
105.   Result:= fStack.Count;
106. end;
107.  
108. function TStringStack.IsEmpty: boolean;
109. begin
110.   Result:= (fStack.Count = 0);
111. end;
112.  
113. procedure TStringStack.Push(const anItem: string);
114. begin
115.   fStack.Push(ssStrNew(anItem));
116. end;
117.  
118. function TStringStack.Pop: string;
119. begin
120.   Result:= ssStrFree(fStack.Pop);
121. end;
122.  
123. function TStringStack.Peek: string;
124. begin
125.   Result:= ssStrCopy(fStack.Peek);
126. end;
127.  
128. end.
129.  

You have to create it before use: MyStack:= TStringStack.Create;
...and destroy it when you're done: MyStack.Free;
Push -> string goes in
Pop  -> string comes out
Peek -> Have a look-see, but don't extract
Clear + Count + IsEmpty => Well duh!
Not much to say 'bout it... it works 
Have fun
Regards Benny

[Joanna]

@rvk I use classes all the time for gui things. In this case I thought something simple would be ok . Objects are a good way to organize variables and the methods that use them but probably are not so good for variables that must be created at runtime.

@cdbc Thanks for the code, I didn’t know about tstack. That’s some nice code but I’ll probably stick with stringlist because I need to remove duplicates and clear it occasionally. Maybe my code is only a stack in the sense that it orders strings in a stack like way.

Thanks to everyone who has helped me figure this out.

[rvk]

Depending on your use-case you might even be better off inheriting TStringList itself.

So.

Code: Pascal  [Select][+][-]

1. type
2.   TStringStack = class(TStringList)
3. //... etc.

and adding your functions to it.

You could also create a helper class for TStringList if your needs are very simple.

And then always use the structure

Code: Pascal  [Select][+][-]

1. my := TStringStack.Create;
2. try
3.   // do your stuff
4. finally
5.   my.Free;
6. end;

You could even make it auto-destruct (so no need for my.Free) of you learn about interfaces.

[Joanna]

@rvk
I already have a tstrings helper . Maybe I should make a tstringlist descendant. Thanks for the idea it would definitely be better organized 

[jamie]

If you want to move it to a RECORD instead of an object you can force the compiler to generate code in the background if the record has a "Class operator initialize(Var S:TheRecordTypeName);

You also need to supply the operator's code of course.

you can look at this page.

https://wiki.freepascal.org/management_operators

With that, you can have a initialize and finalize class operator so when you enter a block of code and declare a variable of one of these records, the compiler will call the initialize operator for you, you don't need to create the code.

P.S.
 You need 3.1.1 fpc compiler min for this to work.

[Joanna]

thanks Jamie i think i need to learn more about those smart records 
here is latest incarnation of the stringstack

Code: Pascal  [Select][+][-]

1.   UNIT STRINGLISTS_2023;  // Created November 14, 2023
2.  
3. {$mode objfpc}{$H+}
4.  
5. INTERFACE
6.  
7. USES
8.   CLASSES, SYSUTILS,Dialogs,HELPERS_UNIT_2023;
9. TYPE
10. TSTRINGSTACK = CLASS (TStringList)
11. STRICT PRIVATE
12.     FUNCTION GET_LATEST_STRING: STRING;
13.     PROCEDURE SET_LATEST_STRING(CONST AVALUE: STRING) ;
14. PUBLIC
15.    PROPERTY LATEST_STRING:STRING READ GET_LATEST_STRING WRITE SET_LATEST_STRING;
16.    PROCEDURE SHOW_STRINGS; // msg with array content that isnt blank
17.    PROCEDURE TEST;
18. END;
19.  
20. IMPLEMENTATION
21.  
22. { TSTRINGSTACK }
23.  
24.  
25.  FUNCTION TSTRINGSTACK.GET_LATEST_STRING: STRING;
26.  BEGIN
27.  IF Count > 0
28.     THEN RESULT:= Strings[0]
29.     ELSE Result:= '';
30.  END;
31.  
32. PROCEDURE TSTRINGSTACK.SET_LATEST_STRING( CONST AVALUE: STRING) ;
33. BEGIN
34. IF (AVALUE = '')  THEN EXIT;  // dont accept empty strings
35. IF IndexOf(AVALUE) = 0
36.    THEN EXIT // it is first one so dont try to insert twice
37.    ELSE IF IndexOf(AVALUE) <> -1
38.            THEN Delete(IndexOf(AVALUE));  // clear the duplicate
39. Insert(0,AVALUE);
40. END;
41.  
42.  PROCEDURE TSTRINGSTACK.SHOW_STRINGS;
43.            VAR
44.            X:Integer;
45.            S:STRING;
46.  BEGIN
47.  S:= 'TSTRINGSTACK.SHOW_STRINGS-> ';
48. FOR X:= 0 TO Count-1 DO
49.    S:= S +' | ' +Strings[X];
50.  ShowMessage(S);
51.  END;
52.  
53.  PROCEDURE TSTRINGSTACK.TEST;
54.            CONST AR:ARRAY[0..6] OF STRING= ('ZERO','ONE','TWO','THREE','FOUR','FIVE','ZERO');
55.            VAR X:INTEGER;
56.  BEGIN
57. FOR X:= 0 TO High(AR) DO
58.     LATEST_STRING := AR[X];
59.  SHOW_STRINGS;
60.  TRUNKATE(4);  //removes strings after third one
61.  SHOW_STRINGS;
62.  END;
63.  
64. END.
65.  
66.